Results 1 to 2 of 2
  1. #1
    Star Lounger
    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

  2. #2
    Plutonium Lounger
    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 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
  •