VBA and Excel optimization of script, dealing with 700,000 rows - vba

Question

Hello StackOverflowers,
I am currently working on a script that has one nested IF statement in it. When run it could potentially compute around 1.4m IF's.
I have run a test with a timer (not too sure on the accuracy of the timer in VBA) and crunching 1000 rows gives me a time of 10 seconds. 10 * 700 = 7000 seconds, which = 1.94 hours.
Can anyone give me any tips for optimisation when dealing with such large data sets?
My code is as follows
Sub itS1Capped()
Dim Start, Finish, TotalTime
Start = Timer
Dim c, d, j, lastRow
c = 1
'find how many rows
With Worksheets("Data")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'loop through all rows
For Each d In Worksheets("Data").Range("D2:D" & lastRow).Cells 'd = IT S0 Uncapped
j = Worksheets("Data").Range("J" & c + 1).Value 'IT Cap
If j <> 0 Then
If d > j Then
Worksheets("Data").Range("K" & c + 1).Value = j 'IT S1 Capped = j
Else
Worksheets("Data").Range("K" & c + 1).Value = d 'IT S1 Capped = d
End If
Else
Worksheets("Data").Range("K" & c + 1).Value = d 'IT S1 Capped = d
End If
c = c + 1
Next
Finish = Timer
TotalTime = Finish - Start
MsgBox TotalTime
End Sub

Answer 1

So I took inspiration from Mark Moore's use of arrays and found that using an array function rather than copying and pasting a plain function across a range is much faster. On my machine, Mark's procedure runs in 2.2 seconds, and the one below in 1.4 seconds.
Sub FormulaArray()
Dim iUsedRows As Long, rCell As Range, StartTimer As Double, Duration As Double
StartTimer = Timer
iUsedRows = ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Rows.Count, 1).Row
With Range(Cells(1, 11), Cells(iUsedRows, 11))
.FormulaArray = "=IF(J:J<>0,IF(D:D>J:J,J:J,D:D),D:D)"
.Copy
.PasteSpecial xlPasteValues
End With
Duration = StartTimer - Timer
MsgBox Format(Duration, "#0.0000") & " seconds to run"
End Sub

Answer 2

I am a bit old school and so "arrays" are your friend :-) Have had similar problems when I first took over looking after some pretty complex spreadsheets at work that did large numbers of validations. When working with large volumes of data, moving between the workbook and the data on the worksheet is not recommended, because each action is effectively an I/O (Input/ output) operation and these are very time consuming. It is massively more efficient to read all your data into an array, work with the array data and then write it back to the sheet at the end, this is effectively 2 I/O's instead of the 700,000 if you read the sheet data each time. As a rough example, I reduced our previous validation time down from 25 minutes to 4 seconds using this approach.
Sub ValidateSheet()
Dim DataRange As String
Dim SheetArray As Variant
Dim StartCol As String
Dim EndCol As String
Dim StartRow As Long ' long to cope with over 32k records
Dim lastrow As Long
Dim WorksheetToRead As String
Dim ArrayLoopCounter As Long
Dim Start, Finish, TotalTime
Start = Timer
'I use variables for the data range simply to allow it to be changed easily. My real code is actually paramatised so a single reusable procedure
'is used to populate all my arrays
'find how many rows
WorksheetToRead = "Data"
StartCol = "A"
EndCol = "Z"
StartRow = 1
lastrow = Sheets(WorksheetToRead).Cells(Rows.Count, "A").End(xlUp).Row
'set the range to be read into the array
DataRange = StartCol & Trim(Str(StartRow)) & ":" & EndCol & Trim(Str(StartRow - 1 + lastrow))
SheetArray = Worksheets(WorksheetToRead).Range(DataRange).Value ' read all the values at once from the Excel grid, put into an array
'Loop around the data
For ArrayLoopCounter = LBound(SheetArray, 1) To UBound(SheetArray, 1)
If SheetArray(ArrayLoopCounter, 10) <> 0 Then '10 is column J
'Compare D with J
If SheetArray(ArrayLoopCounter, 4) > SheetArray(ArrayLoopCounter, 10) Then '10 is column J
SheetArray(ArrayLoopCounter, 11) = SheetArray(ArrayLoopCounter, 10) 'set col K = Col J
Else
SheetArray(ArrayLoopCounter, 11) = SheetArray(ArrayLoopCounter, 4) 'set col K = Col D
End If
Else
SheetArray(ArrayLoopCounter, 11) = SheetArray(ArrayLoopCounter, 4) 'set col K = Col D
End If
Next ArrayLoopCounter
'Write the updated array back to the sheet
Worksheets(WorksheetToRead).Range(DataRange) = SheetArray
Finish = Timer
TotalTime = Finish - Start
MsgBox TotalTime
End Sub

Answer 3

I cannot test this right now, but i believe if you write a function to replace your nested IF statements, add it to Range("K2") with
Range("K2").Formula = ...
then copy it down to Cells(lastrow, "K"), copy all the functions and paste as values it'll be much faster.
Of course using
Application.Calculation = xlCalculationManual
and
Application.Calculation = xlCalculationAutomatic
like enemy suggested, along with
Application.screenupdate = false
Might make it slightly faster, but I think the function-copy-paste will make the biggest difference.
I don't have time to post updated code at the moment, but hopefully I'll get to it tomorrow.
Hope that helps!
EDIT: Here's the revised code
WARNING: I haven't been able to test this code yet. I'll do so tomorrow and revise if needed.
Sub FunctionCopyPaste()
Dim iLastRow as Integer
With Worksheets("Data")
iLastRow = .UsedRange.Cells(.UsedRange.Rows.Count,1).Row
.Range("K2").Formula = "=IF(J2<>0,IF(D2>J2,J2,D2),D2)"
.Range("K2").Copy Range(Cells(2,4), Cells(iLastRow,1).Row,4))
End With
With Range(Cells(2,4), Cells(iLastRow,4))
.Copy
.PasteSpecial xlPasteValues
End With
End Sub

Answer 4

I'm not sure if it will make a difference, but since you are timing it, I'd be interested to know.
I modified your code slightly. The main change is For each D in worksheets. Otherwise, I used Cells(row,col) instead of Range. Not that I expect that change to save time, I just thought you might like to see another way of defining cells, instead of concatenating letters and numbers.
note: with cells, you can use all variables, and numbers, with no letters. I just used letters to show you the similarities.
also, Since you have a c + 1 in every row, why not also just start on row 2, leave out the multiple (+1s) and go from there?
UN-TESTED
Sub itS1Capped()
Dim Start, Finish, TotalTime 'What are you declaring these variables as?
Dim c, d, j, lastRow
Start = Timer
'find how many rows
lastRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).row
'loop through all rows
For c = 2 To lastRow 'c = IT S0 Uncapped (OLD d)
j = Sheets("Data").Cells(c, "J").Value 'IT Cap = Cells(c, 10)
If j <> 0 Then
If c > j Then
Sheets("Data").Cells(c, "K").Value = j 'IT S1 Capped = j
Else
Sheets("Data").Cells(c, "K").Value = c 'IT S1 Capped = c
End If
Else
Sheets("Data").Cells(c, "K").Value = c 'IT S1 Capped = c
End If
Next c
Finish = Timer
TotalTime = Finish - Start
MsgBox TotalTime
End Sub
edit: replaced d with c

Answer 5

Have you tried turning off automatic recalculation before you run your script?
Application.Calculation = xlCalculationManual
And then turn it back on when you're done?
Application.Calculation = xlCalculationAutomatic
That usually speeds up processing of lots of rows assuming you're not changing something that needs recalculating before you work on the next (or subsequent) rows.