I am looking for a faster way to loop through over 150,000 rows

Question

I am currently attempting optimise a set of 4 variables which can have any value between 0.01 and 0.97, the total of these 4 variables must equal 1. Eventually these 4 variables will need to be entered into the spreadsheet in order to return an output (this is a cell in the spreadsheet), ideally I would like to store this output against the 4 inputted variables.

My first step was to attempt to find all the combinations possible; I did this in a very basic form which took over an hour and returned around 150,000 rows. Next I attempted to store the variables in a class before adding them to a collection but this was still quite slow. My next step was to add them into a multi dimensional array but this was just as slow as the collection method. I have already added Application.ScreenUpdating = False and found that Application.Calculation = xlManual made no difference in this case.

Does anyone have any advice on how to make this quicker?

This would need to be repeated a fair amount so ideally wouldn't take an hour to produce all the combinations. I haven't included the part about getting an output as the first step is way too slow and storing those results will use the same process as getting the combinations. I added the secondselapsed after the 3rd next as this takes about 32 seconds and is easier to test with.

My code example using arrays is here:

Sub WDLPerfA()
StartTime = Timer
Application.ScreenUpdating = False

NoRows = 0
Dim combos()
ReDim combos(NoRows, 1)

'Looping through variables
For a = 1 To 97
    For b = 1 To 97
        For c = 1 To 97
            For d = 1 To 97

Application.ScreenUpdating = False

Total = a + b + c + d

If Total = 100 Then

    If NoRows = 0 Then GoTo Line1
        ElseIf NoRows > 0 Then
        NoRows = NoRows + 1
        ReDim combos(NoRows, 1)

Line1:
combo = a & "," & b & "," & c & "," & d
combos(NoRows, 0) = combo

Else: GoTo Line2
End If

Line2:
Next
Next
Next
SecondsElapsed = Round(Timer - StartTime, 2)
Debug.Print SecondsElapsed
Next

End Sub

Answer 1

As an test, I used a Collection to capture all of the combinations to add up to your target value and then stored all those combinations on a worksheet. It didn't take anywhere near an hour.

You don't need GoTo and you don't need to disable ScreenUpdating. But you should always use Option Explicit (read this explanation for why).

The combination loop test is simple:

Option Explicit

Sub FourCombos()
    Const MAX_COUNT As Long = 97
    Const TARGET_VALUE As Long = 100

    Dim combos As Collection
    Set combos = New Collection

    Dim a As Long
    Dim b As Long
    Dim c As Long
    Dim d As Long

    StartCounter
    For a = 1 To MAX_COUNT
        For b = 1 To MAX_COUNT
            For c = 1 To MAX_COUNT
                For d = 1 To MAX_COUNT
                    If (a + b + c + d = TARGET_VALUE) Then
                        combos.Add a & "," & b & "," & c & "," & d
                    End If
                Next d
            Next c
        Next b
    Next a

    Debug.Print "calc time elapsed = " & FormattedTimeElapsed()
    Debug.Print "number of combos  = " & combos.Count

    Dim results As Variant
    ReDim results(1 To combos.Count, 1 To 4)

    StartCounter
    For a = 1 To combos.Count
        Dim combo As Variant
        combo = Split(combos.Item(a), ",")
        results(a, 1) = combo(0)
        results(a, 2) = combo(1)
        results(a, 3) = combo(2)
        results(a, 4) = combo(3)
    Next a
    Sheet1.Range("A1").Resize(combos.Count, 4).Value = results
    Debug.Print "results to sheet1 time elapsed = " & FormattedTimeElapsed()

End Sub

I used a high-performance timer in a separate module to measure the timing. On my system the results were

calc time elapsed = 1.774 seconds
number of combos  = 156849
results to sheet1 time elapsed = 3.394 minutes

The timer code module is

Option Explicit

'------------------------------------------------------------------------------
' For Precision Counter methods
'
Private Type LargeInteger
    lowpart As Long
    highpart As Long
End Type

Private Declare Function QueryPerformanceCounter Lib _
                         "kernel32" (lpPerformanceCount As LargeInteger) As Long
Private Declare Function QueryPerformanceFrequency Lib _
                         "kernel32" (lpFrequency As LargeInteger) As Long

Private counterStart As LargeInteger
Private counterEnd As LargeInteger
Private crFrequency As Double

Private Const TWO_32 = 4294967296#               ' = 256# * 256# * 256# * 256#

'==============================================================================
' Precision Timer Controls
' from: https://stackoverflow.com/a/198702/4717755
'
Private Function LI2Double(lgInt As LargeInteger) As Double
    '--- converts LARGE_INTEGER to Double
    Dim low As Double
    low = lgInt.lowpart
    If low < 0 Then
        low = low + TWO_32
    End If
    LI2Double = lgInt.highpart * TWO_32 + low
End Function

Public Sub StartCounter()
    '--- Captures the high precision counter value to use as a starting
    '    reference time.
    Dim perfFrequency As LargeInteger
    QueryPerformanceFrequency perfFrequency
    crFrequency = LI2Double(perfFrequency)
    QueryPerformanceCounter counterStart
End Sub

Public Function TimeElapsed() As Double
    '--- Returns the time elapsed since the call to StartCounter in microseconds
    If crFrequency = 0# Then
        Err.Raise Number:=11, _
                  Description:="Must call 'StartCounter' in order to avoid " & _
                                "divide by zero errors."
    End If
    Dim crStart As Double
    Dim crStop As Double
    QueryPerformanceCounter counterEnd
    crStart = LI2Double(counterStart)
    crStop = LI2Double(counterEnd)
    TimeElapsed = 1000# * (crStop - crStart) / crFrequency
End Function

Public Function FormattedTimeElapsed() As String
    '--- returns the elapsed time value as above, but in a nicely formatted
    '    string in seconds, minutes, or hours
    Dim result As String
    Dim elapsed As Double
    elapsed = TimeElapsed()
    If elapsed <= 1000 Then
        result = Format(elapsed, "0.000") & " microseconds"
    ElseIf (elapsed > 1000) And (elapsed <= 60000) Then
        result = Format(elapsed / 1000, "0.000") & " seconds"
    ElseIf (elapsed > 60000) And (elapsed < 3600000) Then
        result = Format(elapsed / 60000, "0.000") & " minutes"
    Else
        result = Format(elapsed / 3600000, "0.000") & " hours"
    End If
    FormattedTimeElapsed = result
End Function