Comparison of two excel files using vba coding

Question

I have two excel files called "File1" and "File2" which containing two columns each called Person, Address If person name is matching in both excels then address of that particular person name in both excels need to be compared and differences need to be highlighted. Can anyone help me out with VBA code for this

Answer 1

Compare Columns ( Match feat. Union )

• It is assumed that both workbooks are open.
• Adjust the values in the constants section and the colors near the end of the code.
• The Source/Destination principle makes little sense here, but I prefer it to numbering them.
• In a nutshell, it will loop through the cells of Source trying to match a cell in Destination and checking the adjacent to the right cell values. If they are not equal, both will be highlighted.
• Nothing will happen to not found cell values.

Option Explicit

Sub highlightDifferences()
    
    Const swbName As String = "File1.xlsx"
    Const sName As String = "Sheet1"
    Const sCols As String = "A:B"
    Const sFirstRow As Long = 2
    
    Const dwbName As String = "File2.xlsx"
    Const dName As String = "Sheet2"
    Const dCols As String = "A:B"
    Const dFirstRow As Long = 2
    
    Dim sws As Worksheet: Set sws = Workbooks(swbName).Worksheets(sName)
    Dim srg As Range
    Dim sCell As Range
    With sws.Range(sCols).Rows(sFirstRow)
        Set sCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlValues, , , xlPrevious)
        If sCell Is Nothing Then Exit Sub
        Set srg = .Resize(sCell.Row - .Row + 1)
    End With
    
    Dim dws As Worksheet: Set dws = Workbooks(dwbName).Worksheets(dName)
    Dim drg As Range:
    With dws.Range(dCols).Rows(dFirstRow)
        Dim dCell As Range
        Set dCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlValues, , , xlPrevious)
        If dCell Is Nothing Then Exit Sub
        Set drg = .Resize(dCell.Row - .Row + 1)
    End With
    Dim drg1 As Range: Set drg1 = drg.Columns(1)
    Dim drg2 As Range: Set drg2 = drg.Columns(2)
    
    Dim srgDel As Range
    Dim drgDel As Range
    Dim cIndex As Variant
    
    For Each sCell In srg.Columns(1).Cells
        cIndex = Application.Match(sCell.Value, drg1, 0)
        If IsNumeric(cIndex) Then
            If sCell.Offset(, 1).Value <> drg2.Cells(cIndex).Value Then
                If srgDel Is Nothing Then
                    Set srgDel = sCell.Offset(, 1)
                    Set drgDel = drg2.Cells(cIndex)
                Else
                    Set srgDel = Union(srgDel, sCell.Offset(, 1))
                    Set drgDel = Union(drgDel, drg2.Cells(cIndex))
                End If
            End If
        End If
    Next sCell
    
    If Not srgDel Is Nothing Then
        srgDel.Interior.Color = vbYellow
        drgDel.Interior.Color = vbYellow
    End If

End Sub

Answer 2

Sub CompareAddresses()
    Dim File1 As String
    Dim File2 As String
    Dim Sheetname1 As String
    Dim Sheetname2 As String
    Dim List1 As Variant
    Dim List2 As Variant
    Dim lastrow As Long
    Dim DiffAddress1() As Boolean
    Dim DiffAddress2() As Boolean
    Dim a As Long
    Dim b As Long
    Dim firstRow As Integer
    
    'Define Filepathes and Sheetnames
    File1 = "C:\Excel\File1.xlsx"
    File2 = "C:\Excel\File2.xlsx"
    Sheetname1 = "NameList"
    Sheetname2 = "NameList"
    firstRow = 2 'Row in which the data starts in both sheets
    
    'Open Files and load Data in Arrays
    Workbooks.Open Filename:=File1
    Windows(FilnameFromPath(File1)).activate
    Sheets(Sheetname1).Select
    lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    List1 = Range("A1:B" & lastrow)
    ReDim DiffAddress1(lastrow)

    Workbooks.Open Filename:=File2
    Windows(FilnameFromPath(File2)).activate
    Sheets(Sheetname2).Select
    lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    List2 = Range("A1:B" & lastrow)
    ReDim DiffAddress2(lastrow)
    
    'Check for Differences in Data
    For a = firstRow To UBound(List1, 1)
        For b = firstRow To UBound(List2, 1)
            If List1(a, 1) = List2(b, 1) Then
                If Not List1(a, 2) = List2(b, 2) Then
                    DiffAddress1(a) = True
                    DiffAddress2(b) = True
                End If
            End If
        Next b
    Next a
    
    'Mark Differences in Sheets with yellow background
    Windows(FilnameFromPath(File1)).activate
    Sheets(Sheetname1).Select
    For a = firstRow To UBound(List1, 1)
        If DiffAddress1(a) = True Then
            Range("B" & a).Interior.Color = 65535
        End If
    Next a
    Windows(FilnameFromPath(File2)).activate
    Sheets(Sheetname2).Select
    For a = firstRow To UBound(List2, 1)
        If DiffAddress2(a) = True Then
            Range("B" & a).Interior.Color = 65535
        End If
    Next a
    
End Sub


Public Function FilnameFromPath(FilePath As String) As String
    Dim int_Pos As Integer
    int_Pos = InStrRev(FilePath, "\")
    FilnameFromPath = Mid(FilePath, int_Pos + 1, Len(FilePath) - int_Pos)
End Function