Thread: Specify which worksheets to compare

Thanks Dom for taking the time out to reply

I have tried all day to try to use your suggestion but I just could not get it to work, this is more than likely due to my inexperience, however I did find a solution so I have posted below

Option Explicit
Public Sub CompareData1()
    Dim lr1 As Long
    Dim lr2 As Long
    Dim LR3 As Long
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim Cell1 As Range
    Dim Cell2 As Range
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim X1 As String
    Dim X2 As String
    
   X1 = InputBox(" Please enter the first sheet you want to compare: ")
    X1 = Trim(X1)
    Set ws1 = Sheets(X1)
    
    X2 = InputBox(" Please enter the second sheet you want to compare: ")
    X2 = Trim(X2)
    Set ws2 = Sheets(X2)
    
    Application.ScreenUpdating = False
    Sheets("Compare").Columns("A:k").Delete
    
  
    ws1.Columns("E").ClearContents
    ws2.Columns("E").ClearContents
    
    lr1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    lr2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    Set Rng1 = ws1.Range("A1:A" & lr1)
    Set Rng2 = ws2.Range("A1:A" & lr2)
    
    ' 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"
                LR3 = Sheets("Compare").Range("A" & Rows.Count).End(xlUp).Row + 1
                Cell1.Resize(1, 4).Copy Destination:=Sheets("Compare").Range("A" & LR3)
                Cell2.Resize(1, 4).Copy Destination:=Sheets("Compare").Range("E" & LR3)
            End If
        Next Cell2
    Next Cell1
    
    ' find unmatched items in First sheet
    For Each Cell1 In Rng1
        If Cell1.Offset(0, 4) = "" Then
            LR3 = Sheets("Compare").Range("A" & Rows.Count).End(xlUp).Row + 1
            Cell1.Resize(1, 4).Copy Destination:=Sheets("Compare").Range("A" & LR3)
            Cell1.Copy Destination:=Sheets("Compare").Range("E" & LR3)
            Cell1.Offset(0, 4) = "x"
        End If
    Next Cell1
    ' find unmatched items in Second sheet
    For Each Cell2 In Rng2
        If Cell2.Offset(0, 4) = "" Then
            LR3 = Sheets("Compare").Range("A" & Rows.Count).End(xlUp).Row + 1
            Cell2.Resize(1, 4).Copy Destination:=Sheets("Compare").Range("E" & LR3)
            Cell2.Copy Destination:=Sheets("Compare").Range("A" & LR3)
            Cell2.Offset(0, 4) = "x"
        End If
    Next Cell2
    ' fill blank fields with NO DATA in Compare
    Sheets("Compare").Range("A2:H" & LR3).SpecialCells(xlCellTypeBlanks).Value = "NO DATA"
    ' sort Compare worksheet
    Sheets("Compare").Range("A4:A" & LR3).Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    ws1.Columns("E").ClearContents
    ws2.Columns("E").ClearContents
    Sheets("Compare").Columns.AutoFit
    Sheets("Compare").Columns("E").EntireColumn.Insert
       Columns("E:E").Select

The changes I made were

 Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim X1 As String
    Dim X2 As String
    
   X1 = InputBox(" Please enter the first sheet you want to compare: ")
    X1 = Trim(X1)
    Set ws1 = Sheets(X1)
    
    X2 = InputBox(" Please enter the second sheet you want to compare: ")
    X2 = Trim(X2)
    Set ws2 = Sheets(X2)

Then just changed the named worksheets to ws1 and ws2

Thanks again
Wagstaff

Hi CC,

Attached is a sample file I was working with

When you select the first sheet "Lane 49" for the first choice, ok

Then select the second sheet "Lane 50" for the second choice, ok

When I then try to use the "Compare Data" button I get getting a runtime error 9, subscript out of range which highlights on this part of the code

Set ws1 = Sheets(strPickSheet)

It it because this is no longer the active sheet? As I have selected " Lane 50" with my second selection.

If you can let me now if I have used your code correctly that would be good and also what I have done wrong.

Thanks
Wagstaff