Macro to compare 2 columns and output list with singles and sheet reference

Solved/Closed
Justdance - Updated on Jun 1, 2021 at 12:12 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Jun 1, 2021 at 12:14 PM
Hello,

I am trying to write a macro to compare two different columns on two different sheets. and I want to print only the values that are not on both list. But I want it to record in a way so that I know which list it is missing from.

System Configuration: iPhone / Chrome 90.0.4430.216
Related:

1 response

TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Updated on Jun 1, 2021 at 12:17 PM
Hi JustDance,

Assuming that:
  • The first column is column A on Sheet1
  • The second column is column A on Sheet2
  • These columns contain a header
  • A sheet named Sheet3 exists
  • You want the result on Sheet3 in column A for values and column B for sheet references


then the following code will do the task:
Sub RunMe()
Dim mFind As Range
Dim lRow1, lRow2 As Long

lRow1 = Sheets("Sheet1").Range("A1").End(xlDown).Row
lRow2 = Sheets("Sheet2").Range("A1").End(xlDown).Row

For Each cell In Sheets("Sheet1").Range("A2:A" & lRow1)
    Set mFind = Sheets("Sheet2").Range("A2:A" & lRow2).Find(cell.Value)
    If Not mFind Is Nothing Then
        FirstAddress = mFind.Address
        Do
            Set mFind = Sheets("Sheet2").Range("A2:A" & lRow2).FindNext(mFind)
        Loop While mFind.Address <> FirstAddress
    Else
        Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Value
        Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = "Sheet1"
    End If
Next cell

For Each cell In Sheets("Sheet2").Range("A2:A" & lRow2)
    Set mFind = Sheets("Sheet1").Range("A2:A" & lRow1).Find(cell.Value)
    If Not mFind Is Nothing Then
        FirstAddress = mFind.Address
        Do
            Set mFind = Sheets("Sheet1").Range("A2:A" & lRow1).FindNext(mFind)
        Loop While mFind.Address <> FirstAddress
    Else
        Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = cell.Value
        Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = "Sheet2"
    End If
Next cell
End Sub


Best regards,
Trowa

0