File not responding due to large range of rows?

Question

I have this code that compares 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 implemented on files that have around 16 columns and a lot of rows around 206700.

The problem is that when the new files is created, the process starts but maybe because the overload of having a lot of rows the file shows “Not Responding”. I’ve been waiting for like 10min now and still not responding.

Can anyone help or give me advice concerning this

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 < ws2row Then maxrow = ws2row
  If maxcol < 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 <> colval2 Then
        difference = difference + 1
        Cells(row, col).Formula = colval1 & "<> " & 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 & " cells contain different data! ", vbInformation, _
         "Comparing Two       Worksheets"
End Sub

For long running code excel does this, but it is still running. You can overcome this in several ways: periodically run DoEvents (not every iteration) , write to StatusBar to indicate progress, show a Progress Bar form, or rewrite your code to run faster. There are examples of all these on SO — chris neilsen, Aug 15 '19 at 07:27
If the code works (apart from the performance issue), then you can put it up for review at CodeReview and the helpful mob there will provide advice on how to improve it (including speeding up the results). Remember to take the [tour] and find out [ask] so you present a good question. — AJD, Aug 15 '19 at 07:34
@ chris neilsen wouldn't DoEvents make the progress slower ? — Miriam List, Aug 15 '19 at 13:22

Ahmed AU · Answer 1 · 2019-08-17T07:49:16.620

May try the modified code using Arrays to Compare. Tested with 250000 rows X 26 columns of random data. It takes around 18 secs to compare and another 22 secs to completes report generation with total 40 seconds only. The report format is designed little different as asked. The report generated would show all the rows in Ws1, the font of rows containing difference would be Bold. and cell background of with difference marked red. At the right most column will be set as true or false depending on difference of the row and could be used to filter out any of the options.

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
  Dim Arr1 As Variant, Arr2 As Variant, Arr3 As Variant, Rng As Range
  Dim tm As Double, Change As Boolean
  tm = Timer

  'Application.ScreenUpdating = False
  'Application.Calculation = xlCalculationManual
  'Application.EnableEvents = False


  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 < ws2row Then maxrow = ws2row
  If maxcol < ws2col Then maxcol = ws2col


  Arr1 = ws1.Range(ws1.Cells(1, 1), ws1.Cells(maxrow, maxcol)).Formula
  Arr2 = ws2.Range(ws2.Cells(1, 1), ws2.Cells(maxrow, maxcol)).Formula
  ReDim Arr3(1 To maxrow, 1 To maxcol + 1)

  difference = 0
  For row = 1 To maxrow
  Change = False
    For col = 1 To maxcol
      If Arr1(row, col) <> Arr2(row, col) Then
      difference = difference + 1
      Change = True
      Arr3(row, col) = Arr1(row, col) & ChrW(9747) & Arr2(row, col) 'Unicode character 9747 used as separator between to different values. it is also used for conditional format later. May use character of your choice
      Else
      Arr3(row, col) = Arr1(row, col)  'May change it to Arr2 as default
      End If
    Next col
  Arr3(row, maxcol + 1) = Change
  Next row

  Debug.Print " Calc secs " & Timer - tm
  If difference > 0 Then
  Set Report = Workbooks.Add

  Dim ColLetter As String
  With Report.ActiveSheet
  ColLetter = Split(.Cells(1, maxcol + 1).Address, "$")(1)
  .Range("A1").Resize(UBound(Arr3, 1), UBound(Arr3, 2)).Value = Arr3
  Set Rng = .Range(Report.ActiveSheet.Cells(1, 1), Report.ActiveSheet.Cells(UBound(Arr3, 1), UBound(Arr3, 2)))
  End With

  With Rng
  .FormatConditions.Add Type:=xlTextString, String:=ChrW(9747), TextOperator:=xlContains _
  .FormatConditions(.FormatConditions.Count).SetFirstPriority
     With .FormatConditions(.FormatConditions.Count)
        .Interior.Color = 255
        .Font.Bold = True
        .Font.ColorIndex = 2
     End With
   .FormatConditions.Add Type:=xlExpression, Formula1:="=AND($" & ColLetter & "1)"
     With .FormatConditions(.FormatConditions.Count)
        .Font.Bold = True
     End With

    'Remove both or one line to filter accordingly
    .AutoFilter Field:=maxcol + 1, Criteria1:="TRUE"
    .AutoFilter Field:=maxcol + 1, Criteria1:="FALSE"


   End With

  Debug.Print "Report Generated secs " & Timer - tm
  End If
 'Set Report = Nothing
  'Application.ScreenUpdating = True
  'Application.Calculation = xlCalculationAutomatic
  'Application.EnableEvents = True

  MsgBox difference & " cells contain different data! ", vbInformation, "Comparing Two       Worksheets"
End Sub

Since I personally don't prefer to keep calculations, event processing and screen updating off (in normal cases) i haven't used that standard lines. However you may use these standard techniques, depending on the working file condition.

Answer edited with changed report format. May please test and feedback — Ahmed AU, Aug 17 '19 at 07:50

score 0 · Answer 2 · answered Aug 17 '19 at 09:00

There are 2 practical ways to compare two worksheets:

Method 1: Spreadsheet Compare Tool

This tool comes together with Ms Office Suite. Go to your start menu and look for this icon. Version 2013 is available as well.

It provides a very decent comparison and you can export the results. If you would like to automate this tool as well, you can refer to this How to script Excel 2013's Spreadsheet Compare?

Method 2: Conditional Formatting

This method highlights the differences on the 1st sheet compared to the 2nd sheet. All you need is a conditional rule.

and apply the rule to the entire sheet.

Last but not least, don't brute force the comparison with custom made macro if it is a "big data" comparison. VBA macro is not built for that.

File not responding due to large range of rows?

2 Answers2