Dynamic search for missing values between ListObjects

Viewed 53

I would like to loop through a column of Table1 and if the value is missing in the same column name of Table2, then insert it at the end of Table2. The below code insert the exact number of rows from Table1, but it inserts the value of last row only.

e.g. Table1:

Column Name
Value1
Value2
Value3
Value4

Once I run the macro the Table2 looks like:

Column Name
Value4
Value4
Value4
Value4
Public Sub FindingMissingValues()
    Dim SourceTable As ListObject
    Dim TargetTable As ListObject
    Dim rngDataCell As Range
    
    Set SourceTable = Sheet1.ListObjects("Table1")
    Set TargetTable = Sheet2.ListObjects("Table2")
       
    For Each rngDataCell In SourceTable.ListColumns("Column Name").DataBodyRange.Rows
        If TargetTable.ListColumns("Column Name").DataBodyRange.Find(rngDataCell.Value, , , xlWhole) Is Nothing Then
            TargetTable.ListColumns("Column Name").DataBodyRange.Offset(1).Value = rngDataCell.Value
        End If
    Next rngDataCell
End Sub

It seems that it does not search for the particular cell values. Could you advise me, what am I doing wrong, please?

2 Answers

Try this. As per comment, think you have first add a row to the second table and then insert the value into the bottom row of that column.

There is a good guide to tables here.

Public Sub FindingMissingValues()

Dim SourceTable As ListObject
Dim TargetTable As ListObject
Dim rngDataCell As Range

Set SourceTable = Sheet1.ListObjects("Table1")
Set TargetTable = Sheet2.ListObjects("Table2")
   
For Each rngDataCell In SourceTable.ListColumns("Column Name").DataBodyRange.Rows
    If TargetTable.ListColumns("Column Name").DataBodyRange.Find(rngDataCell.Value, , , xlWhole) Is Nothing Then
        TargetTable.ListRows.Add 'adds row at bottom of table
        TargetTable.ListColumns("Column Name").DataBodyRange.Cells(TargetTable.DataBodyRange.Rows.Count).Value = rngDataCell.Value
    End If
Next rngDataCell

End Sub

Another way which relies on table's ability to auto expand. I would however go with @SJR's answer.

Option Explicit

Public Sub FindingMissingValues()
    Dim SourceTable As ListObject
    Dim TargetTable As ListObject
    Dim rngDataCell As Range
    Dim LastRow As Range
    
    Set SourceTable = Sheet1.ListObjects("Table1")
    Set TargetTable = Sheet2.ListObjects("Table2")
       
    For Each rngDataCell In SourceTable.ListColumns("Column Name").DataBodyRange.Rows
        If TargetTable.ListColumns("Column Name").DataBodyRange.Find(rngDataCell.Value, _
        , , xlWhole) Is Nothing Then
            
            Set LastRow = TargetTable.ListRows(TargetTable.ListRows.Count).Range
            
            TargetTable.ListColumns("Column Name").DataBodyRange.Cells(LastRow.Row + 1 _
            - TargetTable.HeaderRowRange.Row).Value = rngDataCell.Value
        End If
    Next rngDataCell
End Sub

enter image description here

Related