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 <= Gmax - 5        Do While k <= Gmax - 4            Do While l <= Gmax - 3                Do While m <= Gmax - 2                    Do While n <= Gmax - 1                        Do While p <= Gmax                            'most likely to fail to least likely to fail                            If 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) + getSalary(pool.Cells(p, 1))                                If cursalary <= maxsalary And cursalary >= minsalary Then                                    totalID = totalID + getID(pool.Cells(j, 1).Value) + getID(pool.Cells(k, 1).Value) + getID(pool.Cells(l, 1).Value) + getID(pool.Cells(m, 1).Value) + getID(pool.Cells(n, 1).Value) + getID(pool.Cells(p, 1).Value)                                    If checkFlag(totalID) Then                                        results.Cells(o, 1).Value = pool.Cells(j, 1).Value                                        results.Cells(o, 2).Value = pool.Cells(k, 1).Value                                        results.Cells(o, 3).Value = pool.Cells(l, 1).Value                                        results.Cells(o, 4).Value = pool.Cells(m, 1).Value                                        results.Cells(o, 5).Value = pool.Cells(n, 1).Value                                        results.Cells(o, 6).Value = pool.Cells(p, 1).Value                                        results.Cells(o, 7).Value = cursalary                                        results.Cells(o, 8).Value = totalID                                        o = o + 1                                        counter = counter + 1                                    End If                                End If                                cursalary = 0                                totalID = 0                            End If                            p = p + 1                        Loop                        p = 6                        n = n + 1                    Loop                    n = 5                    m = m + 1                Loop                m = 4                l = l + 1            Loop            l = 3            k = k + 1        Loop        k = 2        j = j + 1    Loop    results.Cells(1, 10).Value = counter    counter = 0    'return workbook to normal    Application.Calculation = xlCalculationAutomatic    Application.ScreenUpdating = TrueEnd SubFunction getSalary(name As String) As DoubleDim salary As DoubleDim z As IntegerDim Total As IntegerDim pasted As WorksheetDim book As WorkbookDim results As WorksheetSet book = Excel.ActiveWorkbookSet pasted = book.Sheets(pasted)Set results = book.Sheets(results)Total = Worksheets(pasted).Range(A:A).Cells.SpecialCells(xlCellTypeConstants).CountFor z = 1 To Total    If pasted.Cells(z, 1).Value = name Then        salary = pasted.Cells(z, 2).Value        getSalary = salary        Exit Function    End IfNext zEnd FunctionFunction getID(name As String) As DoubleDim eyeD As DoubleDim z As IntegerDim Total As IntegerDim pasted As WorksheetDim book As WorkbookDim results As WorksheetSet book = Excel.ActiveWorkbookSet pasted = book.Sheets(pasted)Set results = book.Sheets(results)Total = Worksheets(pasted).Range(A:A).Cells.SpecialCells(xlCellTypeConstants).CountFor z = 1 To Total    If pasted.Cells(z, 1).Value = name Then        eyeD = pasted.Cells(z, 4).Value        getID = eyeD        Exit Function    End IfNext zEnd FunctionFunction checkFlag(idsum As Double) As BooleanDim z As IntegerDim flag As BooleanDim Total As IntegerDim pasted As WorksheetDim book As WorkbookDim results As WorksheetDim test As IntegerDim testrange As RangeSet book = Excel.ActiveWorkbookSet pasted = book.Sheets(pasted)Set results = book.Sheets(results)Set testrange = book.Sheets(results).Range(H:H)flag = Falsetest = Application.WorksheetFunction.countA(testrange)If test = 0 Then    flag = True    checkFlag = flag    Exit FunctionElse    Total = Worksheets(results).Range(H:H).Cells.SpecialCells(xlCellTypeConstants).CountEnd Ifflag = TrueFor z = 1 To Total    If results.Cells(z, 8).Value = idsum Then        flag = False        checkFlag = flag        Exit Function    End IfNext zcheckFlag = flagExit FunctionEnd Functionthe getId function and if condition really just handles one thing, duplicated scenarios. I could avoid this if I knew how to properly setup an inner loop to do #choices choose 6 combinations. I am guessing that could probably save a ton of calculating time.The getSalary and getId functions both work from a set choices by 1 array (column) while the checkFlag function works off of a dynamic array that will start at 1 x 1 (column) and grow to as large as ((choices choose 6) - 1) x 1.Once again I am just looking for any advice on the above (working) code. It is as optimized as I could personally make it. Please let me know if I've done anything that isn't ideal I am more then happy to modify it per your suggestions.
Loop through a unique combinations driven by choices
performance;vba;excel
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 arrayarrPool = pool.Range(A1, pool.Cells(Rows.Count, 1).End(xlUp)).ValuearrPool 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)withblah = 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 FunctionOnce 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.