VBA - Copy rows from a sheet X to a sheet Y if rows doesn't already exists, based on column A and column C

Question

I'm trying to do this code for a while now but with no success so far. I would like to copy rows from a sheet X to the end of another sheet Y if rows doesn't already exists in the sheet Y, based on a comparison of the data in columns A and C.

I already did the code when I just needed to compare with one column, and it worked perfectly. I put it just right there so you can see :

sourceLastRow = ws_src.Cells(ws_src.Rows.Count, "A").End(xlUp).Offset(1).Row
destLastRow = ws_dest.Cells(ws_dest.Rows.Count, "A").End(xlUp).Offset(1).Row

    For Each rng In ws_src.Range("A2:A" & sourceLastRow)
        Set foundVal = ws_dest.Range("A2:A" & destLastRow).Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        
        If foundVal Is Nothing Then

            rng.EntireRow.Copy
            ws_dest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
              
        End If
    Next rng

Unfortunately, when I tried to compare two columns I don't get the results I need. I tried the code below but it copy the first row of my first sheet without stopping :

Dim ws_src As Worksheet
Dim ws_dest As Worksheet

Dim rw_src As Range
Dim rw_dest As Range

Set ws_src = Worksheets(1)
Set ws_dest = Worksheets(2)

For Each rw_src In ws_src.Rows

    For Each rw_dest In ws_dest.Rows
        If ws_src.Cells(rw_src.row, 1).Value = ws_dest.Cells(rw_dest.row, 1).Value And ws_src.Cells(rw_src.row, 3).Value = ws_dest.Cells(rw_dest.row, 3).Value Then
        Else: rw_src.EntireRow.Copy
            ws_dest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next rw_dest
Next rw_src

Thank you for your time !

Léa

Answer 1

Try this

Option Explicit

Sub Sample()
    Dim ws_src As Worksheet
    Dim ws_dest As Worksheet
    
    '~~> Change as applicable
    Set ws_src = Sheet1
    Set ws_dest = Sheet2
    
    Dim lRow As Long
    Dim i As Long
    
    '~~> Find Last row in ws_src
    With ws_src
        .AutoFilterMode = False
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    End With
    
    Dim rngToCopy As Range, FilteredRange As Range
    Dim NewRow As Long
    
    With ws_dest
        '~~> Find Last row in ws_dest
        NewRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To lRow
            .AutoFilterMode = False
            
            '~~> Put the filters
            .Range("A1:C" & NewRow).AutoFilter Field:=1, Criteria1:="=" & ws_src.Cells(i, 1).Value2
            .Range("A1:C" & NewRow).AutoFilter Field:=3, Criteria1:="=" & ws_src.Cells(i, 3).Value2

            Set FilteredRange = .Range("A1:C" & NewRow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
            
            '~~> If no match found then store the row in an object
            If Application.CountA(FilteredRange) = 0 Then
                If rngToCopy Is Nothing Then
                    Set rngToCopy = ws_src.Rows(i)
                Else
                    Set rngToCopy = Union(rngToCopy, ws_src.Rows(i))
                End If
            Else
                Set FilteredRange = Nothing
            End If
        Next i
        .AutoFilterMode = False
    End With
    
    '~~> Do the copy in one go
    If Not rngToCopy Is Nothing Then rngToCopy.Copy ws_dest.Rows(NewRow + 1)
End Sub

Important Tip: Whatever method that you follow, whether it is .Find or .Autofilter or anything else, do not copy and paste in the loop. It will be very slow. Do the copying in the end as shown above.