Compare two worksheets and populate the source tab name of each row that does not match

[prab1101]

Hi there,

I got the following piece of code online that compares two tabs and populates the non-matching rows into a third sheet. However, I am also looking to populate the tab name on each row (in the first column), indicating where it came from on the third tab (non-matches). Would anyone be able to help?

Option Explicit

Sub CompareIt()
    Dim ar As Variant
    Dim arr As Variant
    Dim Var As Variant
    Dim v()
    Dim i As Long
    Dim n As Long
    Dim j As Long
    Dim str As String
   
    ar = Sheet1.Cells(10, 1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        ReDim v(1 To UBound(ar, 2))
        For i = 2 To UBound(ar, 1)
            For n = 1 To UBound(ar, 2)
                str = str & Chr(2) & ar(i, n)
                v(n) = ar(i, n)
            Next
            .Item(str) = v: str = ""
        Next
        ar = Sheet2.Cells(10, 1).CurrentRegion.Resize(, UBound(v)).Value
        For i = 2 To UBound(ar, 1)
            For n = 1 To UBound(ar, 2)
                str = str & Chr(2) & ar(i, n)
                v(n) = ar(i, n)
            Next
            If .exists(str) Then
                .Item(str) = Empty
            Else
                .Item(str) = v
            End If
            str = ""
        Next
        For Each arr In .keys
            If IsEmpty(.Item(arr)) Then .Remove arr
        Next
        Var = .items: j = .Count
    End With
    With Sheet3.Range("a1").Resize(, UBound(ar, 2))
        .CurrentRegion.ClearContents
        .Value = ar
        If j > 0 Then
            .Offset(1).Resize(j).Value = Application.Transpose(Application.Transpose(Var))
        End If
    End With
End Sub

 

[DanteAmor]

Hi @prab1101, welcome to the board!

Try this

Sub CompareIt()
    Dim ar As Variant, arr As Variant, Var As Variant, v() As Variant
    Dim i As Long, n As Long, m As Long, j As Long
    Dim str As String
 
    ar = Sheet1.Cells(10, 1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        ReDim v(1 To UBound(ar, 2) + 1)
        For i = 2 To UBound(ar, 1)
            m = 1
            v(m) = Sheet1.Name
            For n = 1 To UBound(ar, 2)
                str = str & Chr(2) & ar(i, n)
                m = m + 1
                v(m) = ar(i, n)
            Next
            .Item(str) = v
            str = ""
        Next
       
        ar = Sheet2.Cells(10, 1).CurrentRegion.Resize(, UBound(v) - 1).Value
        For i = 2 To UBound(ar, 1)
            m = 1
            v(m) = Sheet2.Name
            For n = 1 To UBound(ar, 2)
                str = str & Chr(2) & ar(i, n)
                m = m + 1
                v(m) = ar(i, n)
            Next
            If .exists(str) Then
                .Item(str) = Empty
            Else
                .Item(str) = v
            End If
            str = ""
        Next
        For Each arr In .keys
            If IsEmpty(.Item(arr)) Then .Remove arr
        Next
        Var = .items
        j = .Count
    End With
   
    With Sheet3.Range("a1").Resize(, UBound(ar, 2) + 1)
        .CurrentRegion.ClearContents
        .Cells(1, 1).Value = "Sheet"
        .Offset(, 1).Resize(1, UBound(ar, 2)).Value = ar
        If j > 0 Then
            .Offset(1).Resize(j).Value = Application.Transpose(Application.Transpose(Var))
        End If
    End With
End Sub

 

[prab1101]

Hi Dante,

Works perfectly! Thank you so much for helping god bless you sir!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.