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