If value that is in a column on sheet A but doesn't exist in a column on sheet B add that value to sheet B

Question

I am trying to write a script that will look in a column A on sheet1 and see if it is missing any values from column J on sheet2, and if it is missing have the value added to the bottom of the column on sheet1. I found some example code (see below), however, when I modify it to work across the two sheets I get an error.

Sub Macro1()

Dim rngA As Range, rngB As Range, MySel As Range, LastRow As Long, ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)

With ws
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Set rngA = .Range("A1:A" & LastRow)
    Set rngB = .Range("B1", .Range("B" & .Rows.Count).End(xlUp))
End With

For Each cell In rngB
    If IsError(Application.Match(cell.Value, rngA, 0)) Then
        If MySel Is Nothing Then
            Set MySel = cell
        Else
            Set MySel = Union(MySel, cell)
        End If
    End If
Next cell

If Not MySel Is Nothing Then MySel.Copy Destination:=ws.Range("A" & LastRow + 1)
End Sub

Any help to modify this to function across sheets would be greatly appreciated. Thanks!

Answer 1

Array approach using one-liner for Match()

Instead of looping through a data range you can execute an array Match() to compare data values with reference values by a one-liner:

data = Application.Match(ref, data, 0)

Methodical hint

Findings return the position within the reference array, whereas all non-findings (i.e. new and therefore unique values) can be identified easily by a corresponding error entry. This is used to re-write the data array exclusively by the wanted uniques. The resulting data are eventually added in the needed size to the existing data.

Note that commonly the Match() function loops asking for single search values (1st parameter) within a reference array (2nd parameter), e.g. via Application.Match(SingleSearchValue, reference, 0).

Side note: looping through a range by means of VBA can be time consuming for greater data set, so generally I prefer an array approach.

As OP seems to refer to two sheets with different columns A and J (instead of B), I demonstrate a solution following this requirement.

Option Explicit

Sub AppendNewItems()
'1) get data & reference arrays via function GetDatafield()
    Dim data: data = GetDatafield(Sheet1, "A")  ' current data 
    Dim ref:  ref = GetDatafield(Sheet2, "J")   ' reference values
    Dim NewRow As Long
    NewRow = UBound(data) + 1           ' get starting row for new entries
    
'2) look up all of the data in the reference array and write found positions to data (one-liner)
    data = Application.Match(ref, data, 0)

    'Edit2: check for no or only 1 reference item ' << 2021-07-23/see comment
    On Error Resume Next
    Debug.Print data(1, 1)
    If Err.Number <> 0 Then
        Err.Clear
        ReDim tmp(1 To 1, 1 To 1)
        tmp(1, 1) = data(1)
        data = tmp
    End If
    
'3) take only new (=unique) elements
    Dim i As Long, ii As Long
    For i = 1 To UBound(data)           ' loop through matches
        If IsError(data(i, 1)) Then     ' identify new (=not found) elements by error
            ii = ii + 1                 ' increment uniques counter
            data(ii, 1) = ref(i, 1)     ' replace error element with current reference value
        End If
    Next
'4) add new data to column A (not more than ii elements)
    If ii Then
        Sheet1.Range("A" & NewRow).Resize(ii, 1) = data
    End If

End Sub

Help function GetDatafield()

Function GetDatafield(sht As Worksheet, Col As String)
    Dim LastRow As Long
    LastRow = sht.Range(Col & sht.Rows.Count).End(xlUp).Row
    'return 1-based 2-dim datafield array
    GetDatafield = sht.Range(Col & "1:" & Col & LastRow).Value2

    'force single value into array          ' << Edit 2021-07-22/see comment
    If Not IsArray(GetDatafield) Then       ' or: If LastRow = 1 Then
        ReDim tmp(1 To 1, 1 To 1)
        tmp(1, 1) = sht.Range(Col & "1").Value2
        GetDatafield = tmp                  ' pass 2-dim array
    End If

End Function

Answer 2

You may try the following code modification, you are getting the error due to the variable cell was not declared and ws.Range("B" & .Rows.Count).End(xlUp) is not a valid range, and you should set Range B by referring to another worksheet if you want to do so:

Sub Macro1()

Dim rngA As Range, rngB As Range, MySel As Range
Dim LastRowA As Long, LastRowB As Long
Dim ws As Worksheet
Dim cell As Range

Set ws = ThisWorkbook.Worksheets(1)

With ws
    LastRowA = .Range("A" & .Rows.Count).End(xlUp).Row
    LastRowB = .Range("B" & .Rows.Count).End(xlUp).Row
    Set rngA = .Range("A1:A" & LastRowA)
    Set rngB = .Range("B1:B" & LastRowB)
End With

For Each cell In rngB.Cells

    If IsError(Application.Match(cell.Value, rngA, 0)) Then
        If MySel Is Nothing Then
            Set MySel = cell
        Else
            Set MySel = Union(MySel, cell)
        End If
    End If
Next cell


If Not MySel Is Nothing Then MySel.Copy Destination:=ws.Range("A" & LastRowA + 1)
End Sub

Before:

After: