[TABLE="width: 336"]
<colgroup><col span="2"><col span="2"></colgroup><tbody>[TR]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD="align: right"]4[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD="align: right"]6[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD="align: right"]7[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]7[/TD]
[/TR]
[TR]
[TD="align: right"]8[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]8[/TD]
[/TR]
[TR]
[TD="align: right"]9[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]9
[/TD]
[/TR]
</tbody>[/TABLE]
Code:
Function ListPermut(num As Integer)
'Permutations without repetition
Dim c As Long, r As Long, p As Long
Dim rng() As Long, temp As Long, i As Long
Dim temp1 As Long, y() As Long, d As Long
p = WorksheetFunction.Permut(num, num)
' Create array
ReDim rng(1 To p, 1 To num)
'Create first row in array (1, 2, 3, ...)
For c = 1 To num
rng(1, c) = c
Next c
For r = 2 To p
' 1. Find the first smaller number rng(r-1, c-1)<rng(r-1,c)
For c = num To 1 Step -1
If rng(r - 1, c - 1) < rng(r - 1, c) Then
temp = c - 1
Exit For
End If
Next c
' Copy values from previous row
For c = num To 1 Step -1
rng(r, c) = rng(r - 1, c)
Next c
' 2. Find a larger number than rng(r-1, temp)as far to the right as possible
For c = num 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(num - temp)
i = 0
For d = temp + 1 To num
y(i) = rng(r, d)
i = i + 1
Next d
i = 0
For d = num To temp + 1 Step -1
rng(r, d) = y(i)
i = i + 1
Next d
Exit For
End If
Next c
Next r
ListPermut = rng
End Function
I would like for this to display all of the combinations from 0000 - 9999
When I enter a blank cell and just enter ListPermut(4) it only returns just 1 but I would like to expand this to the entire 4 x 10 matrix. How do I invoke the UDF to display all of the numbers like this
0000
0001
0002
0003
0004
etc.. all the way through 9999
Thanks in advance
<colgroup><col span="2"><col span="2"></colgroup><tbody>[TR]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD="align: right"]4[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD="align: right"]6[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD="align: right"]7[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]7[/TD]
[/TR]
[TR]
[TD="align: right"]8[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]8[/TD]
[/TR]
[TR]
[TD="align: right"]9[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]9
[/TD]
[/TR]
</tbody>[/TABLE]
Code:
Function ListPermut(num As Integer)
'Permutations without repetition
Dim c As Long, r As Long, p As Long
Dim rng() As Long, temp As Long, i As Long
Dim temp1 As Long, y() As Long, d As Long
p = WorksheetFunction.Permut(num, num)
' Create array
ReDim rng(1 To p, 1 To num)
'Create first row in array (1, 2, 3, ...)
For c = 1 To num
rng(1, c) = c
Next c
For r = 2 To p
' 1. Find the first smaller number rng(r-1, c-1)<rng(r-1,c)
For c = num To 1 Step -1
If rng(r - 1, c - 1) < rng(r - 1, c) Then
temp = c - 1
Exit For
End If
Next c
' Copy values from previous row
For c = num To 1 Step -1
rng(r, c) = rng(r - 1, c)
Next c
' 2. Find a larger number than rng(r-1, temp)as far to the right as possible
For c = num 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(num - temp)
i = 0
For d = temp + 1 To num
y(i) = rng(r, d)
i = i + 1
Next d
i = 0
For d = num To temp + 1 Step -1
rng(r, d) = y(i)
i = i + 1
Next d
Exit For
End If
Next c
Next r
ListPermut = rng
End Function
I would like for this to display all of the combinations from 0000 - 9999
When I enter a blank cell and just enter ListPermut(4) it only returns just 1 but I would like to expand this to the entire 4 x 10 matrix. How do I invoke the UDF to display all of the numbers like this
0000
0001
0002
0003
0004
etc.. all the way through 9999
Thanks in advance