Home » excel » vba – What is best way to compare two excel sheets?

vba – What is best way to compare two excel sheets?

Posted by: admin May 14, 2020 Leave a comment

Questions:

I am trying to compare two excel sheets in vba by comparing each and every cell value. Is there any best way to improve performance?

When i have more than 2000 to 3000 rows in my excel sheet. its taking around 5 minutes to execute. Is there any way to optimize this code?

Sub CompareWorksheets(WS1 As Worksheet, WS2 As Worksheet)

Dim dR As Boolean
Dim r As Long, c As Integer, m As Integer
Dim lrow1 As Long, lrow2 As Long, lrow3 As Long
Dim lcoloumn1 As Integer, lcoloumn2 As Integer,
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim dupCount As Long

With WS1.UsedRange
  lrow1 = .Rows.Count
  lcoloumn1 = .Columns.Count
End With

With ws2.UsedRange
  lrow2 = .Rows.Count
  lcoloumn2 = .Columns.Count
End With

maxR = lrow1
maxC = lcoloumn1

If maxR < lrow2 Then maxR = lrow2
If maxC < lcoloumn2 Then maxC = lcoloumn2
DiffCount = 0
lrow3 = 1

For i = 1 To maxR
  dR = True
  Application.StatusBar = "Comparing worksheets " & Format(i / maxR, "0 %") & "..."
  For r = 1 To maxR
      For c = 1 To maxC
          WS1.Select
          cf1 = ""
          cf2 = ""
          On Error Resume Next
          cf1 = WS1.Cells(i, c).FormulaLocal
          cf2 = ws2.Cells(r, c).FormulaLocal
          On Error GoTo 0
          If cf1 <> cf2 Then
              dR = False
              Exit For
          Else
              dR = True
          End If
      Next c
      If dR Then
       Exit For
      End If
   Next r
     If Not dR Then
      dupCount = dupCount + 1
      WS1.Range(WS1.Cells(i, 1), WS1.Cells(i, maxC)).Select
      Selection.Copy
      Worksheets("Sheet3").Select
      Worksheets("Sheet3").Range(Worksheets("Sheet3").Cells(lrow3, 1), Worksheets   ("Sheet3").Cells(lrow3, maxC)).Select
      Selection.PasteSpecial
      lrow3 = lrow3 + 1
      WS1.Select
      For t = 1 To maxC
          WS1.Cells(i, t).Interior.ColorIndex = 19
          WS1.Cells(i, t).Select
          Selection.Font.Bold = True
      Next t
    End If
  Next i
 End Sub

Thanks!

How to&Answers:

Probably the best way is to pass the range values of each sheet to an array.
Then iterate with each element of the array.

Sub test2()

Dim arr1(), arr2() As Variant
Dim i, j As Long

arr1 = Sheets("Sheet1").Range("A1:D4").Value
arr2 = Sheets("Sheet2").Range("A1:D4").Value

For i = 1 To UBound(arr1, 1)
    For j = 1 To UBound(arr1, 2)
        If arr1(i, j) = arr2(i, j) Then 'do the comparison here
            'code here
        End If
    Next j
Next i

End Sub

The above code is for identical Range comparison only.
You need to add another loop otherwise.
Hope this gets you started.

Update:
Below is the equivalent of the part of your code that compares the formula of cells.

Dim arr1(), arr2() As Variant

Set WS1 = ThisWorkbook.Sheets("Sheet1")
Set WS2 = ThisWorkbook.Sheets("Sheet2")

arr1 = WS1.UsedRange.FormulaLocal
arr2 = WS1.UsedRange.FormulaLocal

lrow1 = UBound(arr1, 1)
lrow2 = UBound(arr2, 1)
lcolumn1 = UBound(arr1, 2)
lcolumn2 = UBound(arr2, 2)

maxR = lrow1
maxC = lcoloumn1

If maxR < lrow2 Then maxR = lrow2
If maxC < lcoloumn2 Then maxC = lcoloumn2

DiffCount = 0
lrow3 = 1

For i = 1 To maxR
    dR = True
    Application.StatusBar = "Comparing worksheets " & Format(i / maxR, "0 %") & "..."
    For r = 1 To maxR
        For c = 1 To maxC
            cf1 = ""
            cf2 = ""
            On Error Resume Next
            cf1 = arr1(i, c)
            cf2 = arr2(r, c)
            On Error GoTo 0
            If cf1 <> cf2 Then
                dR = False
                Exit For
            Else
                dR = True
            End If
        Next c
        If dR Then
            Exit For
        End If
    Next r
'the rest of your code goes here which i cannot comprehend.

I was not able to improve the other part of the code, apologies.
i cannot visualize what your trying to accomplish.
Hope this helps you a bit.