Excel VBA - delete / Copy a record from a sheet to another

Question

Lets Say I have two sheets, Sheet 1 and Sheet 2

I have four columns in sheet1 and three similar column headers in sheet 2.

A record from sheet 1 gets deleted if it is not found in sheet2.

A record from sheet 2 is copied into sheet 1 if it is not already there in sheet 1.

In Sheet1, I have the following columns

Name Age Gender  Group
I    25    M     A1
A    24    M     B1
M    23    M     C1
E    23    M     D1

In Sheet 2, I have the following columns

Name Age Gender
F    25    M
A    24    M   
M    23    M

And my output needs to be in sheet1 :

Name Age Gender Group
  A    24    M   B1
  M    23    M   C1
  F    25    M

Note : Each Record is Removed / Copied every time as per the combination of Name, Age and Gender and not just the Name alone.

I created a Concatenated column using VBA and now lost for ideas.

For j = 2 To lastrow

        strA = Sheets(TabName).Range("A" & j).Value
        strB = Sheets(TabName).Range("B" & j).Value
        StrC = Sheets(TabName).Range("C" & j).Value

        Range(CombinedKeyColLet & j).Value = Application.WorksheetFunction.Concat(strA & strB & StrC)

        Cells.Select
        Selection.Columns.AutoFit

        Next
'Copy or Delete code
'--------------------------------'

Here is the code, that I am trying with On error method

    CombinedKeyCol = WorksheetFunction.Match("CombinedKey", Sheets(TabName1).Rows(1), 0)
    CombinedKeyColLet = GetColumnLetter(CombinedKeyCol)

    For i = lastrow To 2 Step -1
              Sheets(TabName2).Activate
              CombinedKeyVal = Range(CombinedKeyColLet & i).Value
              On Error GoTo Jumpdelete
                Present = WorksheetFunction.Match(CombinedKeyVal, Sheets(TabName1).Columns(6), 0)
               If Present <> "" Then
               GoTo Jumpdontdelete
               End If
Jumpdelete:
    Sheets(TabName2).Activate
    Rows(i & ":" & i).Delete
    Present = ""
Jumpdontdelete:
    Present = ""
    Next

Answer 1

This seems to do the trick. There are two loops here, in the first loop we look at each row in tbl1 and see if it exists in tbl2. If it doesn't, then we delete it. If it does exist, we put its concatenated value in a Dictionary so we can remember it exists in both places. In the second loop, we go over tbl2 and for any concatenated value that doesn't exist in dict (Dictionary) then we know it's a "new" row, so we add this data to tbl1.

Option Explicit
Sub foo()
Dim j As Long
Dim rng As Range
Dim tbl1 As Range, tbl2 As Range
Dim dict As Object
Dim val As String
Dim r As Variant
Dim nextRow

Set dict = CreateObject("Scripting.Dictionary")

With Sheet2
    Set tbl2 = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row).CurrentRegion
    tbl2.Columns(4).Formula = "=c[-3]&c[-2]&c[-1]"
End With
With Sheet1
    Set tbl1 = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row).CurrentRegion
End With

For j = tbl1.Rows.Count To 2 Step -1
    'Does this row exist in Table2?
    val = tbl1.Cells(j, 1) & tbl1.Cells(j, 2) & tbl1.Cells(j, 3)
    r = Application.Match(val, tbl2.Columns(4), False)
    If IsError(r) Then
        tbl1.Rows(j).Delete Shift:=xlUp
    Else
        dict(val) = ""  'Keep track that this row exists in tbl1 AND tbl2
    End If
Next
tbl2.Columns(4).ClearContents
Set tbl2 = tbl2.Resize(, 3)
For j = 2 To tbl2.Rows.Count
    val = Join(Application.Transpose(Application.Transpose(tbl2.Rows(j).Value)), "")
    'If the value doesn't exist, then we add row to Tbl1:
    If Not dict.Exists(val) Then
        nextRow = tbl1.Cells(1, 1).End(xlDown).Row + 1
        tbl1.Rows(nextRow).Resize(, 3).Value = tbl2.Rows(j).Value
    End If
Next

End Sub

Note: this necessarily assumes uniqueness in the concatenation of Name/Age/Gender. If there may be duplicates, then this method would need to be modified to not use a Dictionary object, could be done with array or collection etc.