Problems with copying to the next empty row-CodePudding

I am trying to copy data from wsSource to wsDestination if the data doesn't exist in wsDestination. The data copies if the data doesn't exist but it copies to the last row rather than the next empty row.

I have attached screen shots to illustrate this

Screenshot showing data from wsDestination before any copy is done

Screenshot showing data in wsSource

Screenshot showing data in wsDestination after data has been copied

Sub test()
    Dim wsSource As Worksheet, wsDestination As Worksheet
    Dim LastRowSource As Long, LastRowDestination As Long
    Dim i As Long, y As Long
    Dim Value_1 As String, Value_2 As String, Value_3 As String
    Dim ValueExists As Boolean

    With ThisWorkbook
        Set wsSource = .Worksheets("Data Source")
        Set wsDestination = .Worksheets("Data Destination")
    End With

    With wsSource
        'Find the last row of Column C, wsSource
        LastRowSource = .Cells(.Rows.Count, "C").End(xlUp).Row
        'Loop Column C, wsSource
        For i = 13 To LastRowSource
            'Data to be tested if it doesn't exist in wsDestination
            Value_1 = .Range("B" & i).Value 
            Value_2 = .Range("C" & i).Value
            Value_3 = .Range("D" & i).Value
            ValueExists = False

            With wsDestination
                'Find the last row of Column B, wsDestination
                LastRowDestination = .Cells(.Rows.Count, "B").End(xlUp).Row
                'Loop Column B, wsDestination
                For y = 5 To LastRowDestination
                    'Check to see whether data exists
                    If .Range("B" & y).Value = Value_1 Then
                        ValueExists = True
                        Exit For
                    End If
                Next y

                'If data doesn't exist in wsDestination then copy data to next available row 
                If ValueExists = False Then
                    .Range("B" & y).Value = Value_1
                    .Range("C" & y).Value = Value_2
                    .Range("D" & y).Value = Value_3
                End If
            End With
        Next i
    End With
End Sub

CodePudding user response：

If I unterstood your problem, you always want to fill the next empty range on the destination sheet. First of all check this line:

For y = 5 To LastRowDestination

This loop will start from row number 5 which is the header row on the destination sheet. You don't want to accidentally overwrite it, so you start the loop from the 6th row like this:

For y = 6 To LastRowDestination

This line will check your rows to the last row on your destination sheet. So if every empty row has been filled, it will go to your last (not empty) row:

LastRowDestination = .Cells(.Rows.Count, "B").End(xlUp).Row

You want to check 1 row (it will be a guaranteed empty row).

LastRowDestination = .Cells(.Rows.Count, "B").End(xlUp).Row   1

You don't need ValueExists flag, you can check if a range is empty like this:

If WorksheetFunction.CountA(.Range("B" & y & ":D" & y)) = 0 Then ' EMPTY RANGE

So here is the cleaned up version of your code:

Sub test()
Dim wsSource As Worksheet, wsDestination As Worksheet
Dim LastRowSource As Long, LastRowDestination As Long
Dim i As Long, y As Long

    With ThisWorkbook
        Set wsSource = .Worksheets("Data Source")
        Set wsDestination = .Worksheets("Data Destination")
    End With
        
    With wsSource
        'Find the last row of Column C, wsSource
        LastRowSource = .Cells(.Rows.Count, "C").End(xlUp).Row
        'Loop Column C, wsSource
        For i = 13 To LastRowSource
            With wsDestination
                'Find the last row of Column B, wsDestination
                LastRowDestination = .Cells(.Rows.Count, "B").End(xlUp).Row   1
                'Data to be tested if it doesnt exist in wsDestination
                'if IsError is true, data does not exist in wsDestination
                If IsError(Application.VLookup(.Range("B" & i), .Range("B6:B" & LastRowDestination), 1, False)) Then
                    'Loop Column B, wsDestination
                    For y = 6 To LastRowDestination
                        'Check to see whether data existsd
                        If WorksheetFunction.CountA(.Range("B" & y & ":D" & y)) = 0 Then ' EMPTY RANGE
                            .Range("B" & y) = .Range("B" & i)
                            .Range("C" & y) = .Range("C" & i)
                            .Range("D" & y) = .Range("D" & i)
                            Exit For
                        End If
                    Next y
                End If
            End With
        Next i
    End With
End Sub