Answer:

This udf creates permutations from a text string. You can also choose how many letters in each permutation.

Array formula in cell A3:A26:

How to create this array formula

1. Select cell range A3:A26
2. Type above array formula in formula bar
3. Press and hold Ctrl + Shift
4. Press Enter once
5. Release all keys

VBA code

Function ListPermut(str As String, num As Integer)
'Permutations without repetition

Dim c, r, p As Long
Dim rng() As Long, temp As Long, i As Long
Dim temp1 As Long, y() As Long, d As Long
Dim tmpOut(), tmpArr() As Variant
Dim j As Integer
Dim a As Boolean
ReDim tmpArr(0)
ReDim tmpOut(0)

For j = 1 To Len(str)
    tmpArr(UBound(tmpArr)) = Mid(str, j, 1)
    ReDim Preserve tmpArr(UBound(tmpArr) + 1)
Next j

ReDim Preserve tmpArr(UBound(tmpArr) - 1)
p = WorksheetFunction.Permut(Len(str), Len(str))
ReDim rng(1 To p, 1 To Len(str))

For c = 1 To Len(str)
  rng(1, c) = c
Next c

For r = 2 To p

    For c = 1 To num
      tmpOut(UBound(tmpOut)) = tmpOut(UBound(tmpOut)) & tmpArr(rng(r - 1, c) - 1)
    Next c

    If UBound(tmpOut) <> 0 Then
        If tmpOut(UBound(tmpOut)) = tmpOut(UBound(tmpOut) - 1) Then
            tmpOut(UBound(tmpOut)) = ""
        Else
            ReDim Preserve tmpOut(UBound(tmpOut) + 1)
        End If
    Else
        ReDim Preserve tmpOut(UBound(tmpOut) + 1)
    End If

For c = Len(str) To 1 Step -1
  If rng(r - 1, c - 1) < rng(r - 1, c) Then temp = c - 1 Exit For End If Next c For c = Len(str) To 1 Step -1 rng(r, c) = rng(r - 1, c) Next c For c = Len(str) To 1 Step -1 If rng(r - 1, c) > rng(r - 1, temp) Then
  temp1 = rng(r - 1, temp)
  rng(r, temp) = rng(r - 1, c)
  rng(r, c) = temp1
  ReDim y(Len(str) - temp)
  i = 0
    For d = temp + 1 To Len(str)
        y(i) = rng(r, d)
        i = i + 1
    Next d
          i = 0
          For d = Len(str) To temp + 1 Step -1
            rng(r, d) = y(i)
            i = i + 1
          Next d
          Exit For
      End If
  Next c

If r = p Then
    For c = 1 To num
      tmpOut(UBound(tmpOut)) = tmpOut(UBound(tmpOut)) & tmpArr(rng(r, c) - 1)
    Next c
    If tmpOut(UBound(tmpOut)) = tmpOut(UBound(tmpOut) - 1) Then
        ReDim Preserve tmpOut(UBound(tmpOut) - 1)
    End If
End If

Next r

ListPermut = Application.Transpose(tmpOut)

End Function

Where to copy vba code?

Press Alt+F11

Get the Excel file

Chris_ListPermut_norep.xls

Permutations category

Return all combinations
Today I have two functions I would like to demonstrate, they calculate all possible combinations from a cell range. What […]

Find numbers closest to sum
Excelxor is such a great website for inspiration, I am really impressed by this post Which numbers add up to […]

List permutations no repetition [UDF]
This blog post describes how to create permutations, repetition is NOT allowed. Permutations are items arranged in a given order meaning […]

Excel categories

Comments (8)