I am trying to take data from a table and copy it over to another sheet based on an employee's position and contract #. The issue is that on some of the contract #s (but not all) the code will stop executing midway through the table and give a
Run-time error 1004
Application-defined or object-defined error.
The odd part is that up until this point the code is working perfectly. The code is throwing the error the when I try calling WhatPosition within the for loop in the Move function. I have also tried running the code without those two lines, only filling in columns a and b, and it works totally fine through the whole list.
Sub Hourly()
Call Move("1")
' Call Move("2")
' Call Move("3")
' Call Move("4")
End Sub
Public Function LastRow(sheet, col) As Integer
Dim wb2 As Excel.Workbook
Set wb2 = Workbooks.Open("wb2")
With wb2.Worksheets(sheet)
Dim lr As Integer: lr = .Cells(.Rows.count, col).End(xlUp).Row
End With
LastRow = lr
End Function
Sub Move(contract)
Dim wb1 As Excel.Workbook
Set wb1 = Workbooks.Open("wb1")
Dim s1 As Excel.Worksheet
Set s1 = wb1.Worksheets("sheet1")
Dim wb2 As Excel.Workbook
Set wb2 = Workbooks.Open("wb2")
Dim oList As ListObject
Set oList = s1.ListObjects("table1")
Dim oRow As ListRow
Dim test As Long
Dim count As Integer
count = 1
For Each oRow In oList.ListRows
count = count + 1
If s1.Cells(count, 5).Value = contract Then
test = test + 1
wb2.Worksheets(WhatTab(contract)).Cells(LastRow(WhatTab(contract), 1) + 1, 1).Value = s1.Cells(count, 1).Value
wb2.Worksheets(WhatTab(contract)).Cells(LastRow(WhatTab(contract), 2) + 1, 2).Value = s1.Cells(count, 3).Value
wb2.Worksheets(WhatTab(contract)).Cells(LastRow(WhatTab(contract), 1), WhatPosition(contract, count, s1)).Value = s1.Cells(count, 6).Value
wb2.Worksheets(WhatTab(contract)).Cells(LastRow(WhatTab(contract), 1), WhatPosition(contract, count, s1) + 1).Value = s1.Cells(count, 7).Value
End If
Next oRow
End Sub
Public Function WhatTab(contract) As String
If contract = "1" Then
WhatTab = "1"
Else
If contract = "2" Then
WhatTab = "2"
Else
If contract = "3" Then
WhatTab = "3 e"
Else
If contract = "4" Then
WhatTab = "4 e"
Else: MsgBox "New Contract Number or Changed Sheet Name"
End If
End If
End If
End If
End Function
Public Function WhatPosition(contract, counter, sheet) As Integer
Dim wb1 As Excel.Workbook
Set wb1 = Workbooks.Open("wb1")
Dim s1 As Excel.Worksheet
Set s1 = wb1.Worksheets("sheet1")
Dim position As String
position = s1.Cells(counter, 4).Value
If contract = "3" Then
If position = "a" Then
WhatPosition = 3
Else
If position = "b" Then
WhatPosition = 10
Else
If position = "c" Then
WhatPosition = 17
Else
If position = "d" Then
WhatPosition = 24
Else
If position = "e" Then
WhatPosition = 31
Else
If position = "f" Then
WhatPosition = 38
Else
If position = "g" Then
WhatPosition = 45
Else
If position = "h" Then
WhatPosition = 52
Else
If position = "i" Then
WhatPosition = 59
Else
If position = "j" Then
WhatPosition = 66
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Else
If position = "a" Then
WhatPosition = 3
Else
If position = "b" Then
WhatPosition = 7
Else
If position = "c" Then
WhatPosition = 11
Else
If position = "d" Then
WhatPosition = 15
Else
If position = "e" Then
WhatPosition = 19
Else
If position = "f" Then
WhatPosition = 23
Else
If position = "g" Then
WhatPosition = 27
Else
If position = "h" Then
WhatPosition = 31
Else
If position = "i" Then
WhatPosition = 35
Else
If position = "j" Then
WhatPosition = 39
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End Function
To reiterate, the code, including the code calling WhatPosition, works as intended and copies the data until midway through the list it's looping through (table1 which is on sheet1 in wb1). It is giving this issue consistently on contracts 1 and 2, 3 and 4 always work fine. It always stops at the exact same rows, count 24 for contract 1 and 22 for contract 2; there is nothing unusual about these rows in the table.
As Tim said - A bunch of suggestions below. Compiled but not tested:
Sub Hourly()
Call Move("1")
' Call Move("2")
' Call Move("3")
' Call Move("4")
End Sub
Sub Move(Contract As String)
Dim wb1 As Excel.Workbook
Set wb1 = Workbooks.Open("wb1")
Dim s1 As Excel.Worksheet
Set s1 = wb1.Worksheets("sheet1")
Dim wb2 As Excel.Workbook
Set wb2 = Workbooks.Open("wb2")
Dim oList As ListObject
Set oList = s1.ListObjects("table1")
Dim oRow As ListRow
Dim r As Long, PositionColumn As Long, NewRow As Long
Dim WhatWorksheet As Worksheet
Dim Position As String
Dim Source As Range
For r = 1 To oList.ListRows.Count
Set Source = oList.ListRows(r).Range
If Source(1, 5).Value = Contract Then
Set WhatWorksheet = GetWhatWorksheet(Contract, wb2)
If Not WhatWorksheet Is Nothing Then
Position = s1.Cells(r, 4).Value
PositionColumn = WhatPositionColumn(Contract, Position)
With WhatWorksheet
NewRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(NewRow, 1).Value = Source(1, 1).Value
.Cells(NewRow, 2).Value = Source(1, 3).Value
.Cells(NewRow, PositionColumn).Value = Source(1, 6).Value
.Cells(NewRow, PositionColumn + 1).Value = Source(1, 7).Value
End With
End If
End If
Next
End Sub
Public Function GetWhatWorksheet(Contract As String, wb As Workbook) As Worksheet
Dim WorksheetName As String
WorksheetName = WhatTab(Contract)
On Error Resume Next
Set GetWhatWorksheet = wb.Worksheets(WorksheetName)
If Err.Number <> 0 Then
Debug.Print "Worksheet("; WorksheetName; ") for"; Contract; "not found"
End If
On Error GoTo 0
End Function
Public Function WhatTab(Contract As String) As String
Select Case Contract
Case "1"
WhatTab = "1"
Case "2"
WhatTab = "2"
Case "3"
WhatTab = "3 e"
Case "4"
WhatTab = "4 e"
Case Else
MsgBox "New Contract Number or Changed Sheet Name"
End Select
End Function
Public Function WhatPositionColumn(Contract As String, Position As String) As Long
If Contract = "3" Then
WhatPositionColumn = Switch( _
Position = "a", 3, _
Position = "b", 10, _
Position = "c", 17, _
Position = "d", 24, _
Position = "e", 31, _
Position = "f", 38, _
Position = "g", 45, _
Position = "h", 52, _
Position = "i", 59, _
Position = "j", 66 _
)
Else
WhatPositionColumn = Switch( _
Position = "a", 3, _
Position = "b", 7, _
Position = "c", 11, _
Position = "d", 15, _
Position = "e", 19, _
Position = "f", 23, _
Position = "g", 27, _
Position = "h", 31, _
Position = "i", 35, _
Position = "j", 39 _
)
End If
End Function
Note: Although, not an issue here. There is no advantage to using the Integer data-type which has a max value of 32,767, use Long instead which has a cap of 2,147,483,647. This will prevent an overflow error when working with large datasets.
My aim was to demonstrate some techniques that will simplify and make the code easier to read and modify.