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

user_16405022 0
Viewed 451

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

rows compare copy vba excel
2 Answers

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.

user_11405790

This is a simple sample of what you are looking for. Modify the code to fit your needs and try:

Option Explicit

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
    Dim ValueExists As Boolean
    
    With ThisWorkbook
        Set wsSource = .Worksheets("Sheet1")
        Set wsDestination = .Worksheets("Sheet2")
    End With
    
    With wsSource
    
        'Find the last row of Column A, wsSource
        LastRowSource = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        'Loop Column A, wsSource
        For i = 1 To LastRowSource
        
            'Let's say we are testing Columns A & B
            Value_1 = .Range("A" & i).Value
            Value_2 = .Range("B" & i).Value
            
            ValueExists = False
            
            With wsDestination
            
                'Find the last row of Column A, wsDestination
                LastRowDestination = .Cells(.Rows.Count, "A").End(xlUp).Row
                
                'Loop Column A, wsDestination
                For y = 1 To LastRowDestination
                
                    If .Range("A" & y).Value = Value_1 And .Range("B" & y).Value = Value_2 Then
                        ValueExists = True
                        Exit For
                    End If
                    
                Next y
                
                'if value does not exist copy
                If ValueExists = False Then
                    .Range("A" & LastRowDestination + 1).Value = Value_1
                    .Range("B" & LastRowDestination + 1).Value = Value_2
                End If
                
            End With
            
        Next i
        
    End With
    
End Sub
user_67744720
Related