Loop through a unique combinations driven by choices

I am trying to optimize my code and make it as fast as it can be, I have researched as much as I can and am now asking the community for any tips because there are definitely people more experienced than me :).

As of now it is pretty slow for what I am trying to do. The innermost loop will basically loop choices^6 number of times. I will have anywhere from 5 choices up to ~32 choices.

In my main body of code I have three if statements setup that go from most likely to fail to least likely to fail the if condition ie. I am trying to optimize the logic so that I can go through all of the combinations as fast as possible.

```
Sub a_combinations()
Dim pool As Worksheet
Dim results As Worksheet
Dim myBook As Workbook

Dim j As Long, k As Long, l As Long, m As Long, n As Long, o As Long, p As Long
Dim Gmax As Integer
Dim counter As Long

Dim maxsalary As Double
Dim minsalary As Double
Dim cursalary As Double

Dim totalID As Double

'speed up macro
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set myBook = Excel.ActiveWorkbook
Set pool = myBook.Sheets("pool")
Set results = myBook.Sheets("results")

j = 1
k = 2
l = 3
m = 4
n = 5
p = 6

o = 1

'maxsalary = 49400
'minsalary = 45600
maxsalary = 100000
minsalary = 0
cursalary = 0
counter = 0
totalID = 0

Gmax = Worksheets("pool").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
Sheets("results").UsedRange.ClearContents

Do While j k And j <> l And j <> m And j <> n And j <> p And k <> l And k <> m And k <> n And k <> p And l <> m And l <> n And l <> p And m <> n And m <> p And n <> p Then 'takes care of doubles in lineup

cursalary = getSalary(pool.Cells(j, 1).Value) + getSalary(pool.Cells(k, 1).Value) + getSalary(pool.Cells(l, 1).Value) + getSalary(pool.Cells(m, 1).Value) + getSalary(pool.Cells(n, 1).Value) + getS

1) The best performance gains often come from not hitting the sheet unless you really need to.

One way to do this is to read a whole range into an array, then access that instead of reading cell-by-cell.

For example:

Set pool = myBook.Sheets("pool")
'get all the values from ColA in an array
arrPool = pool.Range("A1", pool.Cells(Rows.Count, 1).End(xlUp)).Value

arrPool is now a 1-based 2-d array (n rows x 1 column). You can now replace all calls like this:

blah = pool.Cells(i,1)

with

blah = arrPool(i,1)

and your performance will be much better.

Note the reverse is also true: writing a 2-D array to a worksheet in one call is faster than writing cell-by-cell.

2) Your lookup functions are getting called with the same value over and over, so instead of repeating the work multiple times you can do something like this:

Function getSalary(name As String) As Double

    Static dict As Object
    Dim f As Range

    If name = "reset" Then
        Set dict = Nothing 'reset store
        Exit Function
    End If 

    If dict Is Nothing Then Set dict = CreateObject("scripting.dictionary")

    If Not dict.exists(name) Then 'not already looked for this name

        Set f = ActiveWorkbook.Sheets("pasted").Range("A:A").Find(what:=name, _
                                      LookIn:=xlValues, lookat:=xlWhole)
        If Not f Is Nothing Then
            dict.Add name, f.Offset(0, 1).Value
        Else
            dict.Add name, -999 'not found
        End If
    End If
    getSalary = CDbl(dict(name)) 'return the stored value

 End Function

Once a name has been looked up, the result is stored in the dictionary, keyed on the name: retrieving that value is very fast compared to looking it up on the worksheet.

Use:

getSalary("reset")

to clear the stored values at the top of your code.

StackExchange Code Review Q#132554, answer score: 11