2
\$\begingroup\$

I have code that scans and compares two Excel workbooks, and then pastes all of the differences between the two into a new sheet. My code is working properly - the only problem is when the Excel workbook contains more than 250,000 rows and 33 columns (i.e. more than 1 million cells). When I start running the macros, Excel hangs and restarts.

How can I improve the performance of these macros so that they will scale properly for large data sets? What should I change or add in my code?

Also, since I am new to writing macros, is there anything else that I should change? I've tried researching on Google and Stack Overflow, but couldn't find much relevant information.

Here is my full code (let me know if you need me to provide more):

Public Sub compareWS()
Application.ScreenUpdating = False
On Error GoTo errorhandler1
'Define workbook and worksheets
Set wb3 = Workbooks("ExcelComp.xlsm")
Set wb3sht1 = wb3.Sheets("difference")
Set wb3sht2 = wb3.Sheets("mapping")
Set wb1 = Workbooks(wb3sht2.Range("A3").Value)
Set wb2 = Workbooks(wb3sht2.Range("B3").Value)
'Format headers of difference worksheet
wb3sht1.Cells.ClearContents
wb3sht1.Range("A1").Value = "WB1 value"
wb3sht1.Range("B1").Value = "WB2 value"
wb3sht1.Range("C1").Value = "WB1 header"
wb3sht1.Range("D1").Value = "WB2 header"
wb3sht1.Range("E1").Value = "GUID 2"
wb3sht1.Range("F1").Value = "GUID 1"
wb3sht1.Range("A1:B1").Interior.Color = vbGreen
wb3sht1.Range("C1:D1").Interior.Color = vbCyan
wb3sht1.Range("E1:F1").Interior.Color = vbYellow
For mappingrow = 7 To wb3sht2.Range("A" & Rows.Count).End(xlUp).Row
 'Get workbook and worksheet names in worksheet mapping
 Set wb1sht1 = wb1.Sheets(wb3sht2.Range("A" & mappingrow).Value)
 Set wb2sht1 = wb2.Sheets(wb3sht2.Range("B" & mappingrow).Value)
 'Get the max row and column in two worksheets
 If wb1sht1.UsedRange.SpecialCells(xlCellTypeLastCell).Row > 
 wb2sht1.UsedRange.SpecialCells(xlCellTypeLastCell).Row Then
 maxrow = wb1sht1.UsedRange.SpecialCells(xlCellTypeLastCell).Row
 Else
 maxrow = wb2sht1.UsedRange.SpecialCells(xlCellTypeLastCell).Row
 End If
 If wb1sht1.UsedRange.SpecialCells(xlCellTypeLastCell).Column > 
wb2sht1.UsedRange.SpecialCells(xlCellTypeLastCell).Column Then
 maxcol = wb1sht1.UsedRange.SpecialCells(xlCellTypeLastCell).Column
 Else
 maxcol = wb2sht1.UsedRange.SpecialCells(xlCellTypeLastCell).Column
 End If
 'Compare two woorksheets cell by cell and mark the difference in 
worksheet difference
 For r = 1 To maxrow
 For c = 1 To maxcol
 If UCase(wb1sht1.Cells(r, c).Text) <> UCase(wb2sht1.Cells(r, 
c).Text) Then
 nextrow = wb3sht1.Range("A" & Rows.Count).End(xlUp).Row + 1
 'wb3sht1.Range("A" & nextrow).Value = "'[" & 
wb3sht2.Range("A3").Value & "]" & wb1sht1.Name & "'!" & wb1sht1.Cells(r, 
c).Address
 'wb3sht1.Hyperlinks.Add anchor:=wb3sht1.Range("A" & 
nextrow), Address:="", SubAddress:="'[" & wb3sht2.Range("A3").Value & "]" & 
wb1sht1.Name & "'!" & wb1sht1.Cells(r, c).Address
 'wb3sht1.Range("B" & nextrow).Value = "'[" & 
wb3sht2.Range("B3").Value & "]" & wb2sht1.Name & "'!" & wb2sht1.Cells(r, 
c).Address
 'wb3sht1.Hyperlinks.Add anchor:=wb3sht1.Range("B" & 
nextrow), Address:="", SubAddress:="'[" & wb3sht2.Range("B3").Value & "]" & 
wb2sht1.Name & "'!" & wb2sht1.Cells(r, c).Address
 wb3sht1.Range("A" & nextrow).Value = wb1sht1.Cells(r, 
c).Value
 wb3sht1.Range("B" & nextrow).Value = wb2sht1.Cells(r, 
c).Value
 wb3sht1.Range("C" & nextrow).Value = wb1sht1.Cells(1, 
c).Value
 wb3sht1.Range("D" & nextrow).Value = wb2sht1.Cells(1, 
c).Value
 wb3sht1.Range("E" & nextrow).Value = wb2sht1.Cells(r, 
1).Value
 wb3sht1.Range("F" & nextrow).Value = wb1sht1.Cells(r, 
1).Value
 End If
 Next c
 Next r
Next mappingrow
wb3sht1.Activate
Cells.EntireColumn.AutoFit
Cells.HorizontalAlignment = xlLeft
errorhandler1:
End Sub
Public Sub getWB1Name()
Application.ScreenUpdating = False
On Error GoTo errorhandler1
'Define workbook and worksheets
Set wb3 = Workbooks("ExcelComp.xlsm")
Set wb3sht1 = wb3.Sheets("difference")
Set wb3sht2 = wb3.Sheets("mapping")
Set wb1 = Workbooks(wb3sht2.Range("A3").Value)
Set wb2 = Workbooks(wb3sht2.Range("B3").Value)
startRow = 7
For Each ws In wb1.Sheets
 wb3sht2.Range("A" & startRow).Value = ws.Name
 startRow = startRow + 1
Next ws
errorhandler1:
End Sub
Public Sub getWB2Name()
Application.ScreenUpdating = False
On Error GoTo errorhandler1
'Define workbook and worksheets
Set wb3 = Workbooks("ExcelComp.xlsm")
Set wb3sht1 = wb3.Sheets("difference")
Set wb3sht2 = wb3.Sheets("mapping")
Set wb1 = Workbooks(wb3sht2.Range("A3").Value)
Set wb2 = Workbooks(wb3sht2.Range("B3").Value)
startRow = 7
For Each ws In wb2.Sheets
 wb3sht2.Range("B" & startRow).Value = ws.Name
 startRow = startRow + 1
Next ws
errorhandler1:
End Sub
200_success
146k22 gold badges190 silver badges479 bronze badges
asked Aug 29, 2017 at 2:59
\$\endgroup\$
3
  • 2
    \$\begingroup\$ To start, you can turn off auto calculation (Manual) since everytime you add a Hyperlink, calculations may take place, and add DoEvents just above Next c to give Excel a chance to response from UI etc. You may also want to load the ranges Value onto memory and compare within memory instead of calls Range/Cells. Make use of Application.StatusBar to hint progress. \$\endgroup\$ Commented Aug 29, 2017 at 5:18
  • \$\begingroup\$ For optimization, you may go with arrays instead of range. at the end, you could paste your result data to range. for further info, you may check cpearson.com/excel/ArraysAndRanges.aspx i haven't checked all your code so if this solution is proper for you though. \$\endgroup\$ Commented Aug 29, 2017 at 7:19
  • \$\begingroup\$ I see no Dim in your code. Did you enable Option Explicit ? If not, do it !! \$\endgroup\$ Commented Aug 29, 2017 at 7:23

1 Answer 1

1
\$\begingroup\$

First thing you'd want to do is fix those variables.

Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

When you don't define your variable, VBA will declare it as a Variant type that can hold any type of data. While this may be more flexible, it adds processing time to your macro as VBA decides or tests for the type. Additionally, since a Variant can be any type of data, you may miss out on valuable troubleshooting information on Type Mismatch

Worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Sheets("mapping") and instead just use Mapping.

On this part -

wb3sht1.Range("A1:B1").Interior.Color = vbGreen
wb3sht1.Range("C1:D1").Interior.Color = vbCyan
wb3sht1.Range("E1:F1").Interior.Color = vbYellow

You're using color constants, which, unfortunately, aren't always rendered the same across machines

wb3sht1.Range("E1:F1").Interior.Color = RGB(255,255,0)

Now you guarantee yellow shows up.

When you have a magic number like here

For mappingrow = 7 To wb3sht2.Range("A" & Rows.Count).End(xlUp).Row

It's sometimes better to make a constant

Const MAPPING_BEGIN as Long = 7
mappingLastRow = wb3sht2.Cells(rows.count,1).end(xlup).row
For mappingRow = MAPPING_BEGIN to mappingLastRow
answered Mar 20, 2018 at 5:57
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.