How to make VBA code run faster when looping through 10,000 cells?

Question

Sub GMC()  
    strike = 100
    cap = 120
    part = 3.25
    KO = 60

    For i = 1 To 1000
        exp(i) = Worksheets("Speeder premium").Cells(i + 1, 32)
        If exp(i) >= cap Then
            cash = strike + (part * (cap - strike))
        ElseIf exp(i) >= strike And exp(i) < cap Then
            cash = strike + (part * (exp(i) - strike))
        ElseIf exp(i) < strike And exp(i) >= KO Then
            cash = strike
        ElseIf exp(i) < strike And exp(i) < KO Then
            cash = exp(i)
        End If
        
        Worksheets("Speeder premium").Cells(i + 1, 33) = cash
    Next i
End Sub

So right now I'm repeating the below code for 1000 repetitions but ideally would like to do so for 10,000. I tried doing this with 10,000 and it is very slow and takes too long to process. How do I make the code faster and more efficient?

@SJR meaning? I didn't understand how I should implement the array here. — ameyashete, Dec 04 '20 at 10:54
load full range in an array, make calculs in the array, then copy back array to range — Vincent G, Dec 04 '20 at 10:54
@VincentG so once I have the exp array, I should just loop through each value in that array to see if the if conditions are being met? I'm sorry if I misunderstood, I'm just not able to grasp what you mean by the 'range'. — ameyashete, Dec 04 '20 at 11:03
https://stackoverflow.com/questions/37689847/creating-an-array-from-a-range-in-vba — SJR, Dec 04 '20 at 11:07
@SJR I see thank you for your help. The range method definitely helped. However, the main problem seems to be looping through the `if` conditions and not adding values to the `exp` array. Is there anything that can be done to speed up the check for the if conditions? — ameyashete, Dec 04 '20 at 11:33
Possibly you could do a lookup or use IFS if you have 365. However in an array it will be lightning fast if you're doing it right! — SJR, Dec 04 '20 at 11:37

VBasic2008 · Accepted Answer · 2020-12-05T08:58:47.497

Using Arrays

I would encourage you to use Option Explicit which will force you to declare all variables which among others, will make the code more readable, unexpected behavior (errors) easier traceable... It is a little more work, but in the long run, it will surely pay off.

A Quick Fix

Sub GMC()
    ' Worksheet
    wsName = "Speeder premium"
    fRow = 2
    rCount = 10000
    sCol = 32
    dCol = 33
    ' Data
    Strike = 100
    cap = 120
    part = 3.25
    KO = 60
    ' Define workbook.
    Set wb = ThisWorkbook
    ' Define Source Range.
    Set rng = wb.Worksheets(wsName).Cells(fRow, sCol).Resize(rCount)
    ' Write values from Source Range to Source Array.
    Source = rng.Value
    ' Define Destination Array.
    ReDim Dest(1 To rCount, 1 To 1)
    ' Loop through rows of Source Array, do the calculation, 
    ' and write the results to Destination Array.
    For i = 1 To rCount
        Curr = Source(i, 1)
        If Curr >= cap Then
            cash = Strike + (part * (cap - Strike))
        ElseIf Curr >= Strike And Curr < cap Then
            cash = Strike + (part * (Curr - Strike))
        ElseIf Curr < Strike And Curr >= KO Then
            cash = Strike
        ElseIf Curr < Strike And Curr < KO Then
            cash = Curr
        End If
        Dest(i, 1) = cash
    Next i
    ' Write values from Destination Array to Destination Range.
    rng.Offset(, dCol - sCol).Value = Dest

End Sub

The Option Explicit Version

Option Explicit

Sub GMC2()
    ' Worksheet
    Const wsName As String = "Speeder premium"
    Const fRow  As Long = 2
    Const rCount As Long = 10000
    Const sCol As Long = 32
    Const dCol As Long = 33
    ' Source
    Const Strike As Long = 100
    Const Cap As Long = 120
    Const Part As Double = 3.25
    Const KO As Long = 60
    ' Define Source Range.
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim rng As Range
    Set rng = wb.Worksheets(wsName).Cells(fRow, sCol).Resize(rCount)
    ' Write values from Source Range to Source Array.
    Dim Source As Variant
    Source = rng.Value
    ' Define Target Array.
    Dim Dest As Variant
    ReDim Dest(1 To rCount, 1 To 1)
    ' Loop through rows of Source Array, do the calculation, and write
    ' the results to Destination Array.
    Dim Curr As Variant
    Dim i As Long
    Dim Cash As Double
    For i = 1 To rCount
        Curr = Source(i, 1)
        If Curr >= Cap Then
            Cash = Strike + (Part * (Cap - Strike))
        ElseIf Curr >= Strike And Curr < Cap Then
            Cash = Strike + (Part * (Curr - Strike))
        ElseIf Curr < Strike And Curr >= KO Then
            Cash = Strike
        ElseIf Curr < Strike And Curr < KO Then
            Cash = Curr
        End If
        Dest(i, 1) = Cash
    Next i
    ' Write values from Destination Array to Destination Range.
    rng.Offset(, dCol - sCol).Value = Dest

End Sub

Option Explicit Version with Variable Declarations at the Beginning

Sub GMC3()
    ' Worksheet
    Const wsName As String = "Speeder premium"
    Const fRow  As Long = 2
    Const rCount As Long = 10000
    Const sCol As Long = 32
    Const dCol As Long = 33
    ' Source
    Const Strike As Long = 100
    Const Cap As Long = 120
    Const Part As Double = 3.25
    Const KO As Long = 60
    ' Variables
    Dim wb As Workbook
    Dim rng As Range
    Dim Source As Variant
    Dim Dest As Variant
    Dim Curr As Variant
    Dim i As Long
    Dim Cash As Double
    ' Define Source Range.
    Set wb = ThisWorkbook
    Set rng = wb.Worksheets(wsName).Cells(fRow, sCol).Resize(rCount)
    ' Write values from Source Range to Source Array.
    Source = rng.Value
    ' Define Target Array.
    ReDim Dest(1 To rCount, 1 To 1)
    ' Loop through rows of Source Array, do the calculation, and write
    ' the results to Destination Array.
    For i = 1 To rCount
        Curr = Source(i, 1)
        If Curr >= Cap Then
            Cash = Strike + (Part * (Cap - Strike))
        ElseIf Curr >= Strike And Curr < Cap Then
            Cash = Strike + (Part * (Curr - Strike))
        ElseIf Curr < Strike And Curr >= KO Then
            Cash = Strike
        ElseIf Curr < Strike And Curr < KO Then
            Cash = Curr
        End If
        Dest(i, 1) = Cash
    Next i
    ' Write values from Destination Array to Destination Range.
    rng.Offset(, dCol - sCol).Value = Dest

End Sub

EDIT

Here's a test that might clarify why this code is faster. Use it in a new workbook.

Test

Option Explicit

Sub SpeedTest()
    
    Const Reps As Long = 1000000
    Dim Data As Variant
    ReDim Data(1 To Reps, 1 To 1)
    Dim Data2 As Variant
    ReDim Data2(1 To Reps, 1 To 1)
    Dim t As Double
  
    t = Timer
    With Sheet1.Cells(1, 1).Resize(Reps)
        .Value = Empty
        '.Value = 20000
        '.Value = "This is a test."
        ' This one might take a while (15-20s)(uncomment all four lines):
'        .Offset(, 1).Formula = "=RANDBETWEEN(1,5000)"
'        .Offset(, 1).Value = .Offset(, 1).Value
'        .Formula = "=IF(B1>2500,B1,A1)"
'        .Value = .Value
    End With
    t = Timer - t
    Debug.Print "It took " & t _
        & " seconds to write the data to the worksheet."
    
    t = Timer
    Dim n As Long
    For n = 1 To Reps
        Data(n, 1) = Sheet1.Cells(n, 1).Value
    Next n
    t = Timer - t
    Debug.Print "It took " & t _
        & " seconds to access the worksheet " & Reps _
        & " times to read one cell value."
    Erase Data
    
    t = Timer
    Data2 = Sheet1.Cells(1, 1).Resize(Reps).Value
    t = Timer - t
    Debug.Print "It took " & t _
        & " seconds to access the worksheet once to read " & Reps _
        & " values."
    Erase Data2

End Sub

Thank you for the code. This has worked amazingly well. Could you provide some insight as to exactly why your code has run so much faster than mine? — ameyashete, Dec 05 '20 at 06:21
This code is accessing the worksheet twice: when reading from it `Source = rng.Value` and when writing to it `rng.Offset(, dCol - sCol).Value = Dest`, while your code would be reading 10000 times from it `exp(i) = Worksheets("Speeder premium").Cells(i + 1, 32)` and writing 10000 to it `Worksheets("Speeder premium").Cells(i + 1, 33) = cash`. You might argue that this code reads 10000 values, but the difference in the time needed between reading 10000 or 1 value is obviously a lot smaller than the differece in the time needed for accessing the worksheet 10000 or once. The same goes for writing. — VBasic2008, Dec 05 '20 at 07:37
I've added a test to the bottom of my post for you to better understand what I wrote in the previous comment. — VBasic2008, Dec 05 '20 at 09:00
Ah, I see. Essentially, the code is going through each row, doing the calculation and then assigning that `cash` value to a new array. Though I'm not sure what the `resize` method is doing. The internet did not help in clearing my doubts either. Could you do an ELI5? Does the `resize` method directly help in making the code faster? — ameyashete, Dec 05 '20 at 14:04
From my understanding, `resize` is first selecting the second row and first 32 columns, and then selecting the rest of the rows until 10,000? — ameyashete, Dec 05 '20 at 14:17
You have to be more accurate but if you're talking about this line `wb.Worksheets(wsName).Cells(fRow, sCol).Resize(rCount)` then `wb.Worksheets(wsName).Cells(fRow, sCol)` is representing cell `AF2` and [Resize](https://docs.microsoft.com/en-us/office/vba/api/excel.range.resize) is resizing to the range `AF2:AF10001`. It is only one 2D Array which you could describe as a worksheet range in memory, so when looping through it you manage it similarly to looping through a range in a worksheet only it's much faster. Similarly to cells in a range, you access its elements with e.g. Data(1,1), ... — VBasic2008, Dec 05 '20 at 14:33

How to make VBA code run faster when looping through 10,000 cells?

1 Answers1

Using Arrays