Try this
Code:
Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet)Dim ws1row As Long, ws2row As Long, ws1col As Long
Dim rowval1 As String
Dim difference As Long, exact As Long
Dim row As Long, col As Long
Application.Calculation = xlCalculationManual
With ws1.UsedRange
ws1row = .Rows.Count
ws1col = .Columns.Count
End With
For row = 1 To ws1row
rowval1 = ws1.Cells(row, 1).Value
On Error Resume Next
ws2row = Application.Match(rowval1, ws2.Columns(1), 0)
On Error GoTo 0
If ws2row > 0 Then
If ws1.Evaluate("SUMPRODUCT(COUNTIFS(" & ws2.Cells(row, 1).Resize(, ws1col).Address(, , , True) & "," & _
ws2.Cells(ws2row, 1).Resize(, ws1col).Address(, , , True) & "))") = ws1col Then
exact = exact + 1
Else
difference = difference + 1
End If
End If
Next row
Application.Calculation = xlCalculationAutomatic
Debug.Print difference
Debug.Print exact
'Debug.Print ws1row
'Debug.Print ws1col
End Sub
Bookmarks