Results 1 to 2 of 2

20030120, 20:44 #1
 Join Date
 Feb 2001
 Location
 Auckland, North Island, New Zealand
 Posts
 83
 Thanks
 0
 Thanked 0 Times in 0 Posts
Fill array with all possible combinations (excel xp)
In the code below all varaibles are defined as integers:
noofcells = 3
noofchrs = 2
ReDim allcombinations(1 To noofchrs ^ noofcells, noofcells) 'noofchrs^noofcells=all possible combinations
x = 0
For c1 = 1 To noofchrs 'c1= cell 1
For c2 = 1 To noofchrs 'c2 = cell 2
For c3 = 1 To noofchrs 'c3 = cell 3
x = x + 1 'counts through no of combinations
If x <= noofchrs ^ noofcells Then
allcombinations(x, 1) = c1
allcombinations(x, 2) = c2
allcombinations(x, 3) = c3
Else
End If
Next c3
Next c2
Next c1
The above code fills the array as follows:
For x = 1 To noofchrs ^ noofcells
Debug.Print (allcombinations(x, 1) & allcombinations(x, 2) & allcombinations(x, 3))
Next x
results:
111
112
121
122
211
212
221
222
Which is every possible combination for a 3 wide 2 character number.
How do I create this code so that it can deal with noofcells being any number between 1 and 10 and noofchrs being any number between 1 and 9.
(I understand that I will need an "if" statement that only runs the code when the number of combinations (noofchrs^noofcells) is less than (say) 5,000 so that I am not try to load millions of lines). Is there a maximum array size?
thanks
Simon

20030121, 09:18 #2
 Join Date
 Mar 2002
 Posts
 84,353
 Thanks
 0
 Thanked 29 Times in 29 Posts
Re: Fill array with all possible combinations (excel xp)
Try the following code. It calls a procedure MakeCombinations recursively. I have interspersed the code with comments, but post back if you have questions.
' Global variables
Dim AllCombinations() As Integer
Dim CurrentCombination() As Integer
Dim NoOfCells As Integer
Dim NoOfChrs As Integer
Dim i As Long
Dim iMax As Long
Dim MaxSize As Long
Sub FillCombinations()
' Get input
NoOfCells = InputBox("No of cells")
NoOfChrs = InputBox("No of chars")
MaxSize = InputBox("Max returned values")
' Set limit
iMax = NoOfChrs ^ NoOfCells
If iMax > MaxSize Then
iMax = MaxSize
End If
' Redim
ReDim AllCombinations(1 To iMax, 1 To NoOfCells)
ReDim CurrentCombination(1 To NoOfCells)
' Initialize
i = 0
' Now, go ahead and make combinations
MakeCombinations 1
End Sub
Sub MakeCombinations(k As Long)
' Loop counters
Dim j As Long
Dim m As Long
' Output string
Dim s As String
' Loop through chars
For m = 1 To NoOfChrs
' Set kth char to m
CurrentCombination(k) = m
If k < NoOfCells Then
' Call this procedure recursively
MakeCombinations k + 1
Else
' At end, so store current combination
i = i + 1
' Check if limit is reached
If i > iMax Then
Exit Sub
End If
' Initialize output
s = ""
For j = 1 To NoOfCells
' Store
AllCombinations(i, j) = CurrentCombination(j)
' Build output
s = s & CurrentCombination(j) & " "
Next j
' Display output
Debug.Print s
End If
Next m
End Sub