How to account for empty cells when using cell references to direct VBA

Question

I have data in a table, where I compare two columns J and T . The values which J and T can take include A2B , APL , BGF , CMA , among others (see code).

If these values are equal, copy row i into the sheet which has the name of the cells just checked.

If these values are not equal, copy row i into the sheets which have the name of the cells just checked.

Example : Compare J2 and T2 ,

Suppose J2 = T2 = BGF then copy row 2 and paste into sheet("BGF")

Next, compare J3 and T3

Suppose J3 = BGF and T3 = CMA , copy row 3 and paste into sheet(BGF) and sheet(CMA)

Continue for J4 etc...

Problem : When running this code, If J3 = BGF and T3 = nothing (its empty), then the code throws out an error.

Similarly, if all cells have values, the program throws out a run time error at the end of the data set rather than stopping the program.

Here's my code

Sub Sortdata()
'step 1 clear all data
Sheets("A2B").Cells.ClearContents
Sheets("APL").Cells.ClearContents
Sheets("BGF").Cells.ClearContents
Sheets("CMA").Cells.ClearContents
Sheets("K Line").Cells.ClearContents
Sheets("MacAndrews").Cells.ClearContents
Sheets("Maersk").Cells.ClearContents
Sheets("OOCL").Cells.ClearContents
Sheets("OPDR").Cells.ClearContents
Sheets("Samskip").Cells.ClearContents
Sheets("Unifeeder").Cells.ClearContents

Dim i As Long
With Worksheets("All Data")
    For i = 2 To 10000
        If .Range("J" & i) = .Range("T" & i) Then 'if two cells are equal
            .Rows(i).Copy
            Worksheets(.Range("J" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats ' paste the value at the end of the row.
        Else
            .Rows(i).Copy
            Worksheets(.Range("J" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats ' paste the value at the end of the row.
            .Rows(i).Copy
            Worksheets(.Range("T" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
        End If
    Next i
End With

End Sub

Answer 1

Your issue is when you strike an empty cell, you try to reference a worksheet as

Worksheets("")

which of course fails. So you need to avoid those references.

Here's how I would do it

Sub Sortdata()
    'step 1 clear all data
    Sheets("A2B").Cells.ClearContents
    Sheets("APL").Cells.ClearContents
    Sheets("BGF").Cells.ClearContents
    Sheets("CMA").Cells.ClearContents
    Sheets("K Line").Cells.ClearContents
    Sheets("MacAndrews").Cells.ClearContents
    Sheets("Maersk").Cells.ClearContents
    Sheets("OOCL").Cells.ClearContents
    Sheets("OPDR").Cells.ClearContents
    Sheets("Samskip").Cells.ClearContents
    Sheets("Unifeeder").Cells.ClearContents

    Dim i As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim LastRow As Long


    With Worksheets("All Data")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To LastRow
            If IsEmpty(.Range("J" & i)) Then
                Set ws1 = Nothing
            Else
                Set ws1 = Worksheets(.Range("J" & i).Value)
            End If
            If IsEmpty(.Range("T" & i)) Then
                Set ws2 = Nothing
            Else
                Set ws2 = Worksheets(.Range("T" & i).Value)
            End If

            If ws1 Is Nothing Then
                If Not ws2 Is Nothing Then
                    CopyToWs ws2, .Rows(i)
                End If
            ElseIf ws2 Is Nothing Then
                If Not ws1 Is Nothing Then
                    CopyToWs ws1, .Rows(i)
                End If
            Else
                CopyToWs ws1, Rows(i)
                If ws1.Name <> ws2.Name Then
                    CopyToWs ws2, .Rows(i)
                End If
            End If
        Next
    End With

End Sub

Sub CopyToWs(ws As Worksheet, rng As Range)
    rng.Copy
    ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.PasteSpecial xlPasteValuesAndNumberFormats
End Sub