If you need to generate all permutations of an array I suggest to use the algorithm (external link!) Quickperm. It is one of the most efficient permutation algorithms. It is based on swaps of single array elements and inspired by Heap sort.

The version presented here is the CountDown variant. For the Excel / VBA implementation all indices were increased by one so that arrays start with index 1.






(all Links are external!) Please read my Disclaimer.


Quickperm - Scalable Permutations! The Heart of Artificial Intelligence. The original web site.

Baeldung - Generate All Permutations of an Array. A helpful tutorial which leads to quickperm.

Permutations with side conditions:

Rosetta Code - Permutations with some identical elements

Computer Science - Enumerating all partial permutations of given length in lexicographic order

Appendix – quickperm Code

Please read my Disclaimer.

Option Explicit

Public r As Long 'Output row

Sub QuickPerm(a As Variant)
'Generates all permutations of array a.
'Quickperm is one of the most efficient permutation algorithms.
'It is based on swapping and inspired by Heap sort.
'Countdown variant, indexes increased by 1.
'Algorithm originally from https://www.quickperm.org, migrated to VBA.
'See also: https://www.baeldung.com/cs/array-generate-all-permutations
'Version 0.1 28-Jun-2024
Dim i As Long, idx As Long, j As Long, n As Long, v As Variant
With Application.WorksheetFunction
a = .Transpose(.Transpose(a)) 'Assuming horizontal range
Call VisitPerm(a)
n = UBound(a)
ReDim p(1 To n + 1) As Long
For i = 1 To n + 1: p(i) = i: Next i 'Initialize p()
idx = 2
Do While idx < n + 1
  p(idx) = p(idx) - 1
  If idx Mod 2 = 0 Then
    j = p(idx)
    j = 1
  End If
  v = a(j): a(j) = a(idx): a(idx) = v 'Swap a(j) and a(idx)
  Call VisitPerm(a)
  idx = 2
  Do While p(idx) = 1
    p(idx) = idx
    idx = idx + 1
End With
End Sub

Sub VisitPerm(a As Variant)
'Print current permutation in immediate window and on sheet Output.
'You can analyze the permutation or do other things as well.
Dim i As Long
For i = 1 To UBound(a)
  Debug.Print a(i);
  wsO.Cells(r, i) = a(i)
Next i
r = r + 1
End Sub

Sub test()
r = 1
Call QuickPerm(wsI.Range("A1:D1"))
Call QuickPerm(wsI.Range("A2:C2"))
End Sub


Please read my Disclaimer.

quickperm.xlsm [22 KB Excel file, open and use at your own risk]