Copy whole row if value from first sheet column A exists in second sheet column A

Question

I have two tables in two sheets.
Table from sheet 1 is updated daily.

I need to check if any value in column A (sheet 1) is in column A (sheet 2).
If no, then copy whole row into the table in sheet 2.

Based on Google results I started to write some code.

Dim source            As Worksheet
Dim finaltbl          As Worksheet
Dim rngsource         As Range
Dim rngfinaltbl       As Range

'Set Workbook
Set source = ThisWorkbook.Worksheets("Sheet 1")
Set finaltbl = ThisWorkbook.Worksheets("Sheet 2")

'Set Column
Set rngsource = source.Columns("A")
Set rngfinaltbl = finaltbl.Columns("A")

I assume I need to write some loop.

Answer 1

Update Worksheet With Missing (Unique) Rows (Dictionary)

• Adjust the values in the constants section.

Sub UpdateData()
    
    ' Source
    Const sName As String = "Sheet1"
    Const sFirstCellAddress As String = "A2"
    ' Destination
    Const dName As String = "Sheet2"
    Const dFirstCellAddress As String = "A2"
        
    ' Reference the destination worksheet.
    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets(dName)
    
    Dim drg As Range
    Dim dCell As Range
    Dim drCount As Long
    
    ' Reference the destination data range.
    With dws.Range(dFirstCellAddress)
        Set dCell = .Resize(dws.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If dCell Is Nothing Then Exit Sub ' no data in column range
        drCount = dCell.Row - .Row + 1
        Set drg = .Resize(drCount)
    End With
    
    Dim Data As Variant
    
    ' Write the values from the destination range to an array.
    If drCount = 1 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = drg.Value
    Else
        Data = drg.Value
    End If
    
    ' Write the unique values from the array to a dictionary.
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim Key As Variant
    Dim dr As Long
    
    For dr = 1 To drCount
        Key = Data(dr, 1)
        If Not IsError(Key) Then ' exclude errors
            If Len(Key) > 0 Then ' exclude blanks
                dict(Key) = Empty
            End If
        End If
    Next dr
    
    ' Reference the source worksheet.
    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets(sName)
    
    Dim srg As Range
    Dim sCell As Range
    Dim srCount As Long
    
    ' Reference the source data range.
    With sws.Range(sFirstCellAddress)
        Set sCell = .Resize(sws.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If sCell Is Nothing Then Exit Sub ' no data in column range
        srCount = sCell.Row - .Row + 1
        Set srg = .Resize(srCount)
    End With
        
    ' Write the values from the source range to an array.
    If srCount = 1 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = srg.Value
    Else
        Data = srg.Value
    End If
        
    Dim surg As Range
    Dim sr As Long
    
    ' Loop through the source values...
    For sr = 1 To srCount
        Key = Data(sr, 1)
        If Not IsError(Key) Then ' exclude errors
            If Len(Key) > 0 Then ' exclude blanks
                If Not dict.Exists(Key) Then ' if source value doesn't exist...
                    dict(Key) = Empty ' ... add it (to the dictionary)...
                    If surg Is Nothing Then ' and combine the cell into a range.
                        Set surg = srg.Cells(sr)
                    Else
                        Set surg = Union(surg, srg.Cells(sr))
                    End If
                End If
            End If
        End If
    Next sr
        
    ' Copy all source rows in one go below ('.Offset(1)') the last cell.
    If Not surg Is Nothing Then
        surg.EntireRow.Copy dCell.Offset(1).EntireRow
    End If
    
    MsgBox "Data updated.", vbInformation

End Sub