## Abstract

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.

## Example

Input:

Output:

Quickperm:

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

``````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.
'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)
Else
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
Loop
Loop
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
Debug.Print
r = r + 1
End Sub

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