I have rewritten a recursive procedure to list combinations of values in Excel columns in a way, that instead of one cell string output, there is an array output to Excel range (one value per cell, one combination per row). It lists up to 1 000 000 combinations and executes in 45 seconds / 1 000 000 combinations on my PC. Are any improvements which would let me decrease execution time possible?
Sub ListCombinations()
Dim arr As Variant, outCnt As Long, vOut() As Variant
Dim lastRow As Long
Dim tim As Double: tim = Timer
arr = ThisWorkbook.Worksheets("assignment optimization").Range("b2:j12")
ReDim vOut(1000000, UBound(arr, 2))
outCnt = 1
Arrangements arr, vbNullString, LBound(arr, 2), outCnt, vOut
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("assignment optimization")
With Range(.Cells(1, 12), .Cells(outCnt, 11 + UBound(vOut, 2)))
lastRow = .Columns.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
.Columns.ClearContents
.Value = vOut
End With
End With
Application.ScreenUpdating = True
Debug.Print Timer - tim
End Sub
Sub Arrangements(ByRef arr, ByVal s As String, ByVal lInd As Long, ByRef outCnt As Long, ByRef vOut As Variant)
Dim i As Long, arrayIndex1 As Long
For i = LBound(arr) To UBound(arr)
If arr(i, lInd) <> False Then 'exclude values "FALSE" from listing
If lInd = UBound(arr, 2) Then
For arrayIndex1 = LBound(vOut, 2) To UBound(vOut, 2)
vOut(outCnt, arrayIndex1) = Split(Mid$(s, 2) & "," & arr(i, lInd), ",")(arrayIndex1 - 1)
Next arrayIndex1
If outCnt = 1000000 Then Exit Sub
outCnt = outCnt + 1
Else
vOut(outCnt, lInd) = arr(i, lInd)
Arrangements arr, s & "," & arr(i, lInd), lInd + 1, outCnt, vOut
End If
End If
Next i
End Sub
Edit:
I already found first improvement. Instead of splitting the same string on each arrayIndex1 iteration, I do the splitting outside of the loop and assign it to array. Execution time is now 18 seconds.
Dim outVals () as string
...
outVals = Split(Mid$(s, 2) & "," & arr(i, lInd), ",")
For arrayIndex1 = LBound(vOut, 2) To UBound(vOut, 2)
vOut(outCnt, arrayIndex1) = outVals(arrayIndex1 - 1)
Next arrayIndex1
Edit 2:
Combinations input and output layout:
lastRow
is not used, I wouldRedim Preserve vOut
to fit the data. I don't see the point in partially clearing the old list. Please provide some sample data and a screenshot of the desired output (only 10 rows or so). \$\endgroup\$Redim Preserve
, it requires transposing array and transposing it back, I have a custom procedure to overcome 65k rows limit, but I still find pasting too big array to range which fits desired amount of rows more straightforward. I've added screenshot of input and output data. \$\endgroup\$