I'm new in VBA and actually don't know how to deal with that task. Maybe you can help me.

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

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

Basing on google results I started to write some code but I stuck.

    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 that next I need to write some loop but I really don't know how it works.

CodePudding user response：

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

CodePudding user response：

No you don't need a loop. You need the Find function for a Range See Documentation for Find Method (Excel) also Excel VBA Find A Complete Guide