1. Combinations

How can I create a procedure that will create all the combinations of the numbers 0 to 9? E.g. 0123456789, 1023456789,.. I will store them one by one in a column array. Cheers, Andy.

2. Re: Combinations

Beware that the following is going to run for a LONG time.

<pre>Public Sub AllNums()
Dim I0 As Integer, I1 As Integer, I2 As Integer, I3 As Integer, I4 As Integer
Dim I5 As Integer, I6 As Integer, I7 As Integer, I8 As Integer, I9 As Integer
Dim strNumber As String
For I0 = 0 To 9
For I1 = 0 To 9
For I2 = 0 To 9
For I3 = 0 To 9
For I4 = 0 To 9
For I5 = 0 To 9
For I6 = 0 To 9
For I7 = 0 To 9
For I8 = 0 To 9
For I9 = 0 To 9
strNumber = CStr(I0) & CStr(I1) & CStr(I2) & CStr(I3)
strNumber = strNumber & CStr(I4) & CStr(I5) & CStr(I6)
strNumber = strNumber & CStr(I7) & CStr(I8) & CStr(I9)
Next I9
Next I8
Next I7
Next I6
Next I5
Next I4
Next I3
Next I2
Next I1
Next I0
End Sub
</pre>

3. Re: Combinations

I don't suppose anyone knows where I left the Starship Enterprise? (neat code though!)

4. Re: Combinations

Leagre,

Would that code just give every number between 1 and 9999999999, rather than every combination of 10 digits (ie, with no repeating digits)- which is the way I see the question (I may be wrong though).

Otherwise, the following might do the same:
<pre>For i = 1 To 9999999999
strNumber = Format(i, "0000000000")
Next
</pre>

Otherwise, the code might me changed to:
<pre> For I0 = 0 To 9
For I1 = 0 To 9
If I1 <> I0 Then
For I2 = 0 To 9
If I2 <> I1 And I2 <> I0 Then
</pre>

etc.

I'm sure thought theres a better way.

5. Re: Combinations

Geoff: If you start your For loop at zero instead of 1, then your code and mine will produce the same results. However, yours is much simpler and will probably run faster, depending on how fast Format is.

If you don't want duplicate digits, then your example should do that also.

6. Re: Combinations

Geoff's code seems to be heading along the right lines - I do want to avoid duplicate digits. However, I was hoping there was a simpler way of coding it??

7. Re: Combinations

The following code seems to be doing what I want. It still seems slow though??

Sub Combs()
Dim strNumber As String
Dim varCombs As Variant
Dim intCounter As Integer

For varCombs = 123456789 To 9876543210#
strNumber = CStr(Format(varCombs, "0000000000"))
For intCounter = 1 To 9
If InStr(Right(strNumber, 10 - intCounter), Mid(strNumber, intCounter, 1)) > 0 Then
GoTo SkipNumber
End If
Next intCounter
Debug.Print strNumber
SkipNumber:
Next varCombs
End Sub

This code generates the entire sequence of numbers, then performs string comparisons to if the generated number contains duplicates. Any other ideas?

8. Re: Combinations

The following code generates all the permutations directly. It could probably be improved by more expert VBA'ers.

The last line of output for n=9 on a PIII at 800Mhz or so was:
<pre>Total = 362880 in 183.1543 seconds. (1981.28029858704/sec.)
</pre>

so n=10 would take 10 times this - about 30 minutes. 40 seconds of this is generating the permutations and the other 29m20s is printing them out!

Ian.

<pre>Sub Caller()
Dim iPerm() As Integer
Dim k As Long
Dim strPrint As String
Dim Start As Single

n = InputBox("Number of items")
Start = Timer
ReDim iPerm(1 To n)
For i = 1 To n
iPerm(i) = i
Next i
k = 0
Do While iPerm(1) <> 0
k = k + 1
strPrint = ""
For i = 1 To n
strPrint = strPrint & (iPerm(i) - 1)
Next i
Debug.Print strPrint & " " & k
iPerm = NextPerm(iPerm)
Loop
Debug.Print ("Total = " & k & " in " & (Timer - Start) & "seconds. (" & k / (Timer - Start) & "/sec.)")
End Sub
'
'
Function NextPerm(iPerm() As Integer) As Variant
' iPerm() contains a permutation of 1 2 3 ... n
' NextPerm returns the next permutation of 1 2 ... n after iPerm
' or sets iPerm(1) to 0 if iPerm is the last permutation
' n n-1 ... 1

Dim SubSet() As Integer
Dim n As Integer

n = UBound(iPerm)

If iPerm(1) < n Then 'Shift n left by one place
For j = 2 To n
If iPerm(j) = n Then
iPerm(j) = iPerm(j - 1)
iPerm(j - 1) = n
NextPerm = iPerm
Exit Function
End If
Next j
Else
If n = 2 Then 'Done
iPerm(1) = 0
NextPerm = iPerm
Exit Function
End If
' Get the next permutation of 1 ... (n-1)
' and add n at the end
ReDim SubSet(1 To (n - 1))
For j = 1 To n - 1
SubSet(j) = iPerm(j + 1)
Next j
SubSet = NextPerm(SubSet)
If SubSet(1) = 0 Then
iPerm(1) = 0
NextPerm = iPerm
Exit Function
End If
For j = 1 To n - 1
iPerm(j) = SubSet(j)
Next j
iPerm(n) = n
NextPerm = iPerm
End If
End Function

</pre>

Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•