## Select numbers in each permutation

*Article updated on January 30, 2018*

Maximum Number Allowed is 4 digit and the number is from 0 to 9.

After I fill in the number i want it to automatic permutate the numbers and list in details, example if i key in 1234 and the list will be:

1234, 1243, 1423, 4123, 1324, 1342, 1432, 4132, 3124, 3142, 3412, 4312, 2134, 2143, 2413, 4213, 2314, 2341, 2431, 4231, 3214, 3241, 3421, 4321.

**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**

- Select cell range A3:A26
- Type above array formula in formula bar
- Press and hold Ctrl + Shift
- Press Enter once
- 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

**Download excel file *.xls**

### 4 Responses to “Select numbers in each permutation”

### Leave a Reply

**How to add a formula to your comment:**

<code>your formula</code>

Remember to convert less than and larger than signs to html character entities before you post your comment.

**How to add VBA code to your comment:**

[vb 1="vbnet" language=","]

VBA code

[/vb]

**How to add a picture to your comment:**

Upload picture to postimage.org

Add picture link to comment.

**Contact Oscar**

You can contact me through this webpage

i am trying / looking for a way to write in-excel 2007, 20 numbers out of 1 to 45 like Australian lotto ,there is a site that you probaly know...will give 4 out of 4 numbers while seleecting up to 12 picked.is the a way I can show 45 numbers ie 1 to 45, then use hlookup, and get it to show the cells for the first 6 out of the 45, and so on..

thanks Bert

bert

Can you explain in greater detail?

looks like there's a syntax error with the line starting If rng(r - 1, c - 1) < rng(r - 1, c) Then..... unable to execute the code

Thanks for making your code accessible to everyone. Super helpful!

Kayla

Thank you for telling me, I hope it works now.

In case it is not working, there is a file you can download.