Specify which worksheets to compare

Hi Everyone,

I have a problem and am hoping someone can help.

I have a code that compares data between 2 sheets and populates sheet"compare" with the old and new values, I would like the macro instead of having pre-defined sheet names to be able to have an input box that the user types in which sheet they want to compare.

I have tried to myself but I just get errors

Can anyone assist me please

My code is

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 Sh As Worksheets
    Dim Sh1 As Worksheets
    Application.ScreenUpdating = False
    Sheets("Compare").Columns("A:k").Delete
    
    
   'Answer = InputBox("Please enter the first sheet you want to compare", vbOK)
   'If Answer = vbOK Then
   'Set Sh = Answer
    'Set Sh = InputBox("Please enter the second sheet you want to compare")
    Sheets("Lane 49").Columns("E").ClearContents
    'Sh.Columns("E").ClearContents
    
    Sheets("Lane 50").Columns("E").ClearContents
    'Sh1.Columns("E").ClearContents
    lr1 = Sheets("Lane 49").Range("A" & Rows.Count).End(xlUp).Row
    lr2 = Sheets("Lane 50").Range("A" & Rows.Count).End(xlUp).Row
    Set Rng1 = Sheets("Lane 49").Range("A1:A" & lr1)
    Set Rng2 = Sheets("Lane 50").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 Data1
    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 Data2
    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
    Sheets("Lane 49").Columns("E").ClearContents
    Sheets("Lane 50").Columns("E").ClearContents
    Sheets("Compare").Columns.AutoFit
    Sheets("Compare").Columns("E").EntireColumn.Insert
       Columns("E:E").Select

The code then enters a formula and then I do some formatting.

Hopefully you can see where I have tried to modify the code to include an input box

Thanks
Wagstaff