I recently came across a thread where jaslake posted a macro that will allow you to compare two sheets of data and show the data that does and does not match on the two sheets.

The thread can be found HERE.

I started modifying the code to see if I could expand the comparison to three sheets (and hopefully more) and did the following:

Option Explicit
Public Sub CompareData()
    Dim LR1 As Long
    Dim LR2 As Long
    Dim LR3 As Long
    Dim LR4 As Long 'added
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim Rng3 As Range 'added
    Dim Cell1 As Range
    Dim Cell2 As Range
    Dim Cell3 As Range 'added
    
    Application.ScreenUpdating = False
    Sheets("Compare").Cells.Delete
    Sheets("Data1").Columns("E").ClearContents
    Sheets("Data2").Columns("E").ClearContents
    Sheets("Data3").Columns("E").ClearContents 'added

    LR1 = Sheets("Data1").Range("A" & Rows.Count).End(xlUp).Row
    LR2 = Sheets("Data2").Range("A" & Rows.Count).End(xlUp).Row
    LR3 = Sheets("Data3").Range("A" & Rows.Count).End(xlUp).Row 'added
    
    Set Rng1 = Sheets("Data1").Range("A1:A" & LR1)
    Set Rng2 = Sheets("Data2").Range("A1:A" & LR2)
    Set Rng3 = Sheets("Data3").Range("A1:A" & LR3) 'added

    ' Find Matches between sheets
    For Each Cell1 In Rng1
        For Each Cell2 In Rng2
            If Cell1 = Cell2 And Cell1.Offset(0, 4) = "" And _
               Cell2.Offset(0, 4) = "" Then
                Cell1.Offset(0, 4) = "x"
                Cell2.Offset(0, 4) = "x"
                LR4 = Sheets("Compare").Range("A" & Rows.Count).End(xlUp).Row + 1 'changed from LR3
                Cell1.Resize(1, 4).Copy Destination:=Sheets("Compare").Range("A" & LR4) 'changed from LR3
                Cell2.Resize(1, 4).Copy Destination:=Sheets("Compare").Range("E" & LR4) 'changed from LR3
            End If
        Next Cell2
    Next Cell1

    ' find unmatched items in Data1
    For Each Cell1 In Rng1
        If Cell1.Offset(0, 4) = "" Then
            LR4 = Sheets("Compare").Range("A" & Rows.Count).End(xlUp).Row + 1 'changed from LR3
            Cell1.Resize(1, 4).Copy Destination:=Sheets("Compare").Range("A" & LR4) 'changed from LR3
            Cell1.Copy Destination:=Sheets("Compare").Range("E" & LR4) ''changed from LR3
            Cell1.Offset(0, 4) = "x"
        End If
    Next Cell1

    ' find unmatched items in Data2
    For Each Cell2 In Rng2
        If Cell2.Offset(0, 4) = "" Then
            LR4 = Sheets("Compare").Range("A" & Rows.Count).End(xlUp).Row + 1 'changed from LR3
            Cell2.Resize(1, 4).Copy Destination:=Sheets("Compare").Range("E" & LR4) 'changed from LR3
            Cell2.Copy Destination:=Sheets("Compare").Range("A" & LR4) 'changed from LR3
            Cell2.Offset(0, 4) = "x"
        End If
    Next Cell2

 ' find unmatched items in Data3
    For Each Cell3 In Rng3 'Changed from Cell2 In Rng2
        If Cell3.Offset(0, 4) = "" Then 'Changed from Cells2
            LR4 = Sheets("Compare").Range("A" & Rows.Count).End(xlUp).Row + 1 'changed from LR3
            Cell3.Resize(1, 4).Copy Destination:=Sheets("Compare").Range("E" & LR4) 'changed from Cell2 & LR3
            Cell3.Copy Destination:=Sheets("Compare").Range("A" & LR4) 'changed from Cell2 & LR3
            Cell3.Offset(0, 4) = "x" ''changed from Cell2
        End If
    Next Cell2

    ' fill blank fields with NO DATA in Compare
    Sheets("Compare").Range("A2:H" & LR4).SpecialCells(xlCellTypeBlanks).Value = "NO DATA" 'changed from LR3

    ' sort Compare worksheet
    ActiveWorkbook.Worksheets("Compare").Sort.SortFields.Clear
    Sheets("Compare").Sort.SortFields.Add Key:=Range("A2:A" & LR4) _
                                        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'changed from LR3
    With Sheets("Compare").Sort
        .SetRange Range("A2:H" & LR4) 'changed from LR3
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Sheets("Data1").Columns("E").ClearContents
    Sheets("Data2").Columns("E").ClearContents
    Sheets("Data3").Columns("E").ClearContents 'added
    Sheets("Compare").Columns.AutoFit
    Sheets("Compare").Columns("E").EntireColumn.Insert
    Application.ScreenUpdating = True
End Sub

All of my changes are based on assumption.

The one section that needs an experts eye is the following:


    ' Find Matches between sheets
    For Each Cell1 In Rng1
        For Each Cell2 In Rng2
           For Each Cell3 In Rng3 ' added
            If Cell1 = Cell2 And Cell1.Offset(0, 4) = "" And _
               Cell2.Offset(0, 4) = "" Then
                Cell1.Offset(0, 4) = "x"
                Cell2.Offset(0, 4) = "x"
                LR4 = Sheets("Compare").Range("A" & Rows.Count).End(xlUp).Row + 1 'changed from LR3
                Cell1.Resize(1, 4).Copy Destination:=Sheets("Compare").Range("A" & LR4) 'changed from LR3
                Cell2.Resize(1, 4).Copy Destination:=Sheets("Compare").Range("E" & LR4) 'changed from LR3
            End If
        Next Cell2
    Next Cell1

I added and changed the basic but cannot figure out how to modify


If Cell1 = Cell2 And Cell1.Offset(0, 4) = "" And _

to reference the 3rd worksheet.

Will this work once the code is modified or is 3+ sheets not possible to compare in this format?