# Thread: Fill array with all possible combinations (excel xp)

1. ## 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

2. ## 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 k-th 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

#### Posting Permissions

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