Find differences between two spreadsheets I have this code that is supposed to compare two Excel sheets. The code is working fine for small comparisons. I did a test run with 7 rows and 2 columns.

The code itself works as follows: it compares the two sheets and copies the differences into a new workbook.

However, the code should be applied to files that have around 16 columns and a lot of rows (around 206700).  It doesn't seem to scale very well to these larger sheets - the process is shown “Not Responding”, for more than ten minutes when I gave up.

This is how my excel file columns looks likem, keeping in mind that most of them contain text and only few times numbers are used.


I'd like to improve the performance with these larger files; any other suggestions for improvement are also welcome.

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
  Dim report As Workbook, difference As Long
  Dim row As Long, col As Integer

  Set report = Workbooks.Add

  With ws1.UsedRange
    ws1row = .Rows.Count
    ws1col = .Columns.Count
  End With

  With ws2.UsedRange
    ws2row = .Rows.Count
    ws2col = .Columns.Count
  End With

  maxrow = ws1row
  maxcol = ws1col
  If maxrow &lt; ws2row Then maxrow = ws2row
  If maxcol &lt; ws2col Then maxcol = ws2col

  difference = 0

  For col = 1 To maxcol
    For row = 1 To maxrow
      colval1 = ""
      colval2 = ""
      colval1 = ws1.Cells(row, col).Formula
      colval2 = ws2.Cells(row, col).Formula
      If colval1 &lt;&gt; colval2 Then
        difference = difference + 1
        Cells(row, col).Formula = colval1 &amp; "&lt;&gt; " &amp; colval2
        Cells(row, col).Interior.Color = 255
        Cells(row, col).Font.ColorIndex = 2
        Cells(row, col).Font.Bold = True
      End If
    Next row
  Next col

  Columns("A:B").ColumnWidth = 25
  report.Saved = True

  If difference = 0 Then
    report.Close False
  End If
  Set report = Nothing
  MsgBox difference &amp; " cells contain different data! ", vbInformation, _
         "Comparing Two       Worksheets"
End Sub
There are some issues with your code:

1) Try to avoid unqualified references, this means always specify the worksheet, when referencing a cell.

2) Try to avoid formatting a lot of single cells, rather format them all at once at the end. Formatting slows down Excel a lot!

3) When handeling a great deal of Ranges, Integer can be insufficient, use Long instead.

Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet)

  Dim ws1row As Long, ws2row As Long, ws1col As Long, ws2col As Long
  Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String
  Dim report As Workbook, difference As Long
  Dim row As Long, col As Long
  Dim unionRng as Range

  Set report = Workbooks.Add

  With ws1.UsedRange
    ws1row = .Rows.Count
    ws1col = .Columns.Count
  End With

  With ws2.UsedRange
    ws2row = .Rows.Count
    ws2col = .Columns.Count
  End With

  maxrow = ws1row
  maxcol = ws1col
  If maxrow &lt; ws2row Then maxrow = ws2row
  If maxcol &lt; ws2col Then maxcol = ws2col

  difference = 0

  With report.Sheets(1)
    For col = 1 To maxcol
      For row = 1 To maxrow
        colval1 = ""
        colval2 = ""
        colval1 = ws1.Cells(row, col).Formula
        colval2 = ws2.Cells(row, col).Formula

        If colval1 &lt;&gt; colval2 Then
          difference = difference + 1
          .Cells(row, col).Value = colval1 &amp; "&lt;&gt; " &amp; colval2 'I guess you want to show, that the formulas used are not equal.
          If unionRng is Nothing Then
            Set unionRng = .Cells(row, col)
          Else
            Set unionRng = Application.Union(unionRng, .Cells(row, col))
          End If
        End If
      Next row
    Next col

    .Columns("A:B").ColumnWidth = 25
  End With

  unionRng.Interior.Color = 255
  unionRng.Font.ColorIndex = 2
  unionRng.Font.Bold = True
  report.SaveAs Filename:="report.xlsx"

  If difference = 0 Then
    report.Close False
  End If
  Set report = Nothing
  MsgBox difference &amp; " cells contain different data! ", vbInformation, _
         "Comparing Two       Worksheets"
End Sub
```