Match two columns over two sheets

I have a situation where I need to find matches in two columns (combined) on two sheets, so for example, if the entries in A2 and B2 match the entries in A5 and B5 on the second sheet, this is a match. Both sheets must show an exact match, so if on sheet 1, A2 says '1 Capital Hill' and B2 says 'Cat' and then on sheet 2, A5 say's '1 Capital Hill' and B5 say's 'Dog', then this is NOT a match, both fields have to match.

I have an excellent macro, created by protonLeah which checks for matches between sinlge columns on two sheets which works really well, but I have no idea how this could be adapted to achieve the above?

This macro runs a comparison and put the cell reference for the match on the second sheet in a user specified column. I need the same to outcome, but based on checking two columns at once.

Is this possible?

I've attached a very simple basic sample to demonstratewhat I'm trying to achieve.

Option Explicit

Public Sub Compare_Button()

    Dim frmProgress As UserForm1
    
    Dim TestCell    As Range, _
        TestResult  As Range, _
        ResultRange As Range, _
        TestSheet   As Worksheet, _
        BaseSheet   As Worksheet, _
        ResultSheet As Worksheet, _
        LastCell    As Long, _
        BaseRange   As String, _
        TestRange   As String, _
        FirstAddr   As String, _
        FrmtConds   As String
        
        
    On Error GoTo Cancelled
        

    Set TestCell = Application.InputBox("Click the Column Header for the data to be tested", Type:=8)
    TestCell.Parent.Select
    Set TestSheet = ActiveSheet
    
    LastCell = TestSheet.Cells(Rows.Count, TestCell.Column).End(xlUp).Row
    TestRange = TestCell.Resize(LastCell, 1).Address(0, 0)
    
    Set TestCell = Application.InputBox("Click the Column Header to use for comparison", Type:=8)
    TestCell.Parent.Select
    Set BaseSheet = ActiveSheet
    
    LastCell = BaseSheet.Cells(Rows.Count, TestCell.Column).End(xlUp).Row
    BaseRange = TestCell.Resize(LastCell, 1).Address(0, 0)
    
    Set ResultRange = Application.InputBox("Click the Column Header you wish to save the results in", Type:=8)
    ResultRange.Parent.Select
    Set ResultSheet = ActiveSheet
    
    
    Set frmProgress = New UserForm1
    frmProgress.Show vbModeless
    frmProgress.Message = "Calculating... this could take up to an hour. Hit esc to cancel"
    
    
    'set format conditions for column
    LastCell = Range(TestRange).Rows.Count
    Set ResultRange = Range(Cells(2, ResultRange.Column), Cells(LastCell, ResultRange.Column))
    FrmtConds = "=NOT(ISBLANK(" & ResultRange.Address(0, 1) & "))"
    
    ResultRange.Columns.EntireColumn.Select
    Selection.FormatConditions.Delete
    ResultRange.Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:=FrmtConds
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = RGB(255, 255, 0)
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    
    TestSheet.Select
    Application.ScreenUpdating = False

    
    For Each TestCell In TestSheet.Range(TestRange)
        With BaseSheet.Range(BaseRange)
            Set TestResult = .Find(TestCell.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not TestResult Is Nothing Then
                FirstAddr = TestResult.Address(0, 0)
                ResultSheet.Cells(TestCell.Row, ResultRange.Column).Value = "X"
                ResultSheet.Cells(TestCell.Row, ResultRange.Column).Value = TestResult.Address(0, 0)
                
                Do
                    Set TestResult = .FindNext(TestResult)
                    If Not TestResult Is Nothing Then
'                        ResultSheet.Cells(TestCell.Row, ResultRange.Column).Value = "Matches with cell"
                        ResultSheet.Cells(TestCell.Row, ResultRange.Column).Value = TestResult.Address(0, 0)
                    End If
                Loop While Not TestResult Is Nothing And TestResult.Address(0, 0) <> FirstAddr
            End If
        End With 'TestRange
    Next TestCell
    ResultRange.Cells(1, 1).Select
    Selection.End(xlDown).Select
    ActiveWindow.LargeScroll Down:=1

    Unload frmProgress
    Set frmProgress = Nothing

    Application.ScreenUpdating = True
Cancelled:
End Sub