Excel VBA fast compare values of row in two different workbooks

aadityapatel1984

New member
Joined
May 2, 2014
Messages
3
Reaction score
0
Points
0
My worksheet 1 contains around 2000 rows in column1 and same no of rows contained in worksheet 2 in column1
Is there any way i can compare value(string or integer) in particular row in work sheet 1 to check it is present in any one the row in work sheet 2
I have written one sample vba code for this but its taking considerable amount to time to get the result

Code:
Code:
Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet)
Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String, rowval1 As String, rowval2 As String
Dim report As Workbook, difference As Long
Dim exact As Long
Dim row As Long, col As Integer
With ws1.UsedRange
ws1row = .Rows.Count
ws1col = .Columns.Count
End With
With ws2.UsedRange
ws2row = .Rows.Count
ws2col = .Columns.Count
End With
difference = 0
exact = 0
For row = 1 To ws1row
    rowval1 = ws1.Cells(row, 1).Formula
    For row1 = 1 To ws1row
        rowval2 = ws2.Cells(row1, 1).Formula
    If rowval1 = rowval2 Then
        For col = 1 To ws1col




        colval1 = ""
        colval2 = ""
        colval1 = ws1.Cells(row, col).Formula
        colval2 = ws2.Cells(row, col).Formula
        If colval1 <> colval2 Then
            difference = difference + 1
        Else
            exact = exact + 1
        End If
        Next col
    End If
    Next row1
Next row




Debug.Print difference
Debug.Print exact
'Debug.Print ws1row
'Debug.Print ws1col




End Sub

Please help to resolve my problem
 
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
 
Code:
Sub M_snb()
   [sheet2!B1:B100] = [if(sheet1!A1:A100="","",iferror(match(sheet1!A1:A100,sheet2!$A$1:$A$100,0),"_"))]
   [sheet2!B1:B100].Sort Sheet2.Cells(1, 2)
End Sub
The matching values will get a number in column B in sheet2; the unique values will get an "_"
 
Back
Top