vba excel - table object error in For...Next

[devofish]

I have some code that works when isolated to a separate workbook, but when integrating it into my project, there is an issue with the loop. Sheet, column and range references are identical from testing to runtime. The objective is for data entered into a table being copied to another worksheet. During runtime, the loop starts with the first for, however, upon second iteration, I get an object variable not set error on

dws.Range("B" & dlr).value = cell.value

I'm at a complete loss since I don't know why it works for one situation, but not the other. Can anyone see something that I could be overlooking?

Public Sub PasteData()

    Dim sws As Worksheet, dws As Worksheet
    Dim tbl As ListObject
    Dim CodeCell As Range, BottomCell As Range
    Dim dlr As Long
    Dim chkStr As String
    
    Set wb = ThisWorkbook
    Set sws = wb.Sheets(1)
    Set dws = wb.Sheets(2)
    Set tbl = sws.ListObjects("Table")
    Set BottomCell = dws.Range("B:B").Find(what:="This is the bottom", lookat:=xlWhole)
    
'    On Error GoTo Err
        Application.ScreenUpdating = False
    
        For Each cell In tbl.DataBodyRange.Columns(2).Cells
            If cell <> "" Then
                chkStr = cell.value & cell.Offset(0, 1).value & cell.Offset(0, 3).value & cell.Offset(0, 4).value & cell.Offset(0, 5).value & _
                    cell.Offset(0, 2).value & cell.Offset(0, 6).value
                If Not InvoiceFound(chkStr) Then
                    If dws.Range("B17").value = "" Then
                        dlr = 17
                    Else
                        Set CodeCell = dws.Range("B:B").Find(what:="Baseline", after:=dws.Range("B16"), lookat:=xlWhole)
                        dlr = CodeCell.End(xlUp).Row + 1
                        dws.Rows(dlr).Insert
                        BottomCell.Offset(-4).EntireRow.Delete
                    End If
                    
                    dws.Range("B" & dlr).value = cell.value
                    dws.Range("C" & dlr).value = cell.Offset(0, 1).value
                    dws.Range("F" & dlr).value = cell.Offset(0, 3).value
                    dws.Range("G" & dlr).value = cell.Offset(0, 4).value
                    dws.Range("H" & dlr).value = cell.Offset(0, 5).value
                    dws.Range("I" & dlr).value = cell.Offset(0, 2).value
                    dws.Range("J" & dlr).value = cell.Offset(0, 6).value
                    
                End If
            End If
        Next cell            Call MatchInvoiceData
'Err:
        Application.ScreenUpdating = True

End Sub

 

[StephenCrump]

My first guess is that the problem is with cell.value, because you have inadvertently deleted the row containing cell (although the error message isn't quite what I'd expect):

For Each cell In tbl.DataBodyRange.Columns(2).Cells

    '...
    BottomCell.Offset(-4).EntireRow.Delete
    '...
    dws.Range("B" & dlr).Value = cell.Value

When the code breaks: What is cell.Value? And what about dws.Range("B" & dlr).Address?

 

[devofish]

Sort of. I tried everything. I just copy transferred the spreadsheet and code into the main project directly and that one works. Identical code so I am at a loss as to why one is throwing an error and the other is not. I would post the code, but its the same except it doesn't break.
After debugging the code in question line by line, error actually starts on

[COLOR=#333333]Set CodeCell = dws.Range("B:B").Find(what:="Baseline", after:=dws.Range("B16"), lookat:=xlWhole)[/COLOR]

CodeCell shows that it is an object variable not set where it should be set to Nothing. But the error isn't thrown until vba tells it to write at

[COLOR=#574123]dws.Range("B" & dlr).value = cell.value[/COLOR]

The cell.Value is object variable not set, but the dws.Range("B" & dlr).Address = (2,18) as it should be.

cell.Value should actually be the value in the table B3.

Unless its something blatantly obvious, you can let this fade to oblivion. Sometimes the simplest solution is the most obvious. Thanks for the reply.

 

[StephenCrump]

I don't really follow what you're saying here about errors starting ...

The .Find must be working, otherwise CodeCell would be Nothing, and you'd get an error on the next line:

dlr = CodeCell.End(xlUp).Row + 1

The cell.Value is object variable not set, but the dws.Range("B" & dlr).Address = (2,18) as it should be.

cell.Value should actually be the value in the table B3.

It still looks like the problem is with cell.Value (although I'd expect to see a run time error 424: object required error message)? My guess is still that you're inadvertently deleting the row containing cell.

 

[devofish]

After some testing, I was able to concoct this together...

Public Sub PasteData()

    Dim sws As Worksheet, dws As Worksheet
    Dim tbl As ListObject
    Dim CodeCell As Range
    Dim dlr As Long
    Dim Expense1 As Range
    
    Application.ScreenUpdating = False
    
    Set sws = Sheets(1)
    Set dws = Sheets(2)
    Set tbl = sws.ListObjects("Table")
    Set Expense1 = wb.Sheets(3).Range("D36")
    
    On Error GoTo Err
    
    For Each cell In tbl.DataBodyRange.Columns(4).Cells
        If cell <> "" Then
            Set CodeCell = dws.Range("B:B")
            dlr = CodeCell.End(xlUp).Row + 1
            dws.Rows(dlr).Insert
            dws.Range("B" & dlr).value = "Code"
            dws.Range("C" & dlr).value = "Expense1: " & cell.value
                With dws.Range("D" & dlr)
                    .value = Expense1
                    .NumberFormat = "_($* #,##0.00_)"
                End With
            dws.Range("E" & dlr).value = cell.Offset(0, 2).value
            dws.Range("F" & dlr).value = cell.Offset(0, 3).value
            dws.Range("G" & dlr).value = cell.Offset(0, 4).value
                With dws.Range("H" & dlr)
                    .value = Expense1 * cell.Offset(0, 4).value
                    .NumberFormat = "_($* #,##0.00_)"
                End With
        End If
    Next cell


CleanExit:
    Exit Sub
    Application.ScreenUpdating = True


Err:
    MsgBox "There was an error with the transfer. If you have received this " & _
        "message, contact tech support immediately", vbCritical
    GoTo CleanExit


End Sub