none
VBA Code for Combinations/For Loops RRS feed

  • Question

  • Here is my info:

    Block1:  A

    Block2:  B C

    Block3:  B

    Block4:  ABC  (and so on..)

    The number of Blocks could vary (i.e. I could have up to Block22 or something); as well the number of choices could change (i.e. I could have A,B,C,D,E and F to choose from). My program will have the user define the number of Blocks, and for each Block state which of the letters could occur for that particular Block. What I would like to do in Excel VBA is after the user defines this information, the program outputs every combination. For the example above this is how it would look with for loops:

    for i=1 to 1 'there is only 1 choice A
       for i=1 to 2 'B and C are the choices
          for i=1 to 1
            for i=1 to 3 'ABC are choices hence 3
               fill cells in an array with the specific combination
            next
          next
        next
    next

    I have read up on recursion, but I can't seem to make it work nor understand the code people write. How do I do this?

    Tuesday, July 18, 2017 6:26 PM

All replies

  • Say Input is A B C. You want

    A

    B

    C

    AB

    BC

    AC

    ABC

    If wrong, mention what will be output

    Sub Caller()
        
        Worksheets.Add
        
        Call CreateC(3)
        
    
    End Sub
    
    Function CreateC(lNumT As Long, Optional sT As String = "", Optional lPos As Long = 1)
    
        Dim k As Long
        Dim sO As String
                    
        For k = lPos To lNumT
            sO = sT & Chr(64 + k)
            Cells(D, 1).Value = sO
            D = D + 1
            
            If (k < lNumT) Then
                Call CreateC(lNumT, sO, k + 1)
            End If
            
        Next k
                
        
    End Function
    


    Best Regards,
    Asadulla Javed,
    Jadavpore & Asansol

    Wednesday, July 19, 2017 9:53 AM
    Answerer
  • Hi Gradient127

    What is the block? I think it could regard as an array, right? What you want to do is iterating through several arrays and list all combinations of their members, right?

    I also think it is a good idea to use recursion if you want to specific numbers of array.

    Here is the example.

    Dim arr ' dim the arr as global variable so it could be used in recursion method
    Sub TEST()
    arr = Array( _
    Array("A"), _
    Array("B1", "B2"), _
    Array("C1", "C2", "C3"), _
    Array("D1", "D2", "D3", "D4"), _
    Array("E1", "E2", "E3", "E4", "E5"))
    Dim number As Integer
    number = 4 'numbers of array you want to specific
    recursionArr "", arr(0), 1, number
    End Sub
    
    Sub recursionArr(str, arrNext, nextIndex As Integer, stopIndex As Integer)
    Dim index As Integer
    index = nextIndex + 1
    For Each cha In arrNext
    tmp = str & cha
    If index <= stopIndex Then
    recursionArr tmp, arr(index - 1), index, stopIndex
    Else
    Debug.Print tmp
    End If
    Next cha
    End Sub

    Test Result

    AB1C1D1

    AB1C1D2

    AB1C1D3

    AB1C1D4

    AB1C2D1

    AB1C2D2

    AB1C2D3

    AB1C2D4

    AB1C3D1

    AB1C3D2

    AB1C3D3

    AB1C3D4

    AB2C1D1

    AB2C1D2

    AB2C1D3

    AB2C1D4

    AB2C2D1

    AB2C2D2

    AB2C2D3

    AB2C2D4

    AB2C3D1

    AB2C3D2

    AB2C3D3

    AB2C3D4

    Best Regards,

    Terry

    Wednesday, July 19, 2017 10:02 AM
  • Hi Terry,

    A Block is just the name I am using. It could be names of people like Bob, Sue, Pam, etc. So I guess to modify your response, the type of output I would be looking for is (in Combination 1, I have put which choice came from what block. These apply to all combinations, but I wouldn't want (from Block#) to appear in my actual output:

    Combination 1: A (from Block1), B (from Block2), B (from Block3), A (from Block4)
    Combination 2: A,B,B,B
    Combination 3: A,B,B,C
    Combination 4: A,C,B,A
    Combination 5: A,C,B,B
    and so on...

    Wednesday, July 19, 2017 5:26 PM
  • Hi Gradient127,

    You could create a global variable to count combinations count.

    Here is example.

    Dim count As Integer

    Sub recursionArr(str, arrNext, nextIndex As Integer, stopIndex As Integer)

    Dim index As Integer

    index = nextIndex + 1

    For Each cha In arrNext

    tmp = str & cha & ","

    If index <= stopIndex Then

    recursionArr tmp, arr(index - 1), index, stopIndex

    Else

    count = count + 1

    Debug.Print "Combination " & count & ":" & Mid(str, 1, Len(str) - 1)

    End If

    Next cha

    End Sub

    Best Regards,

    Terry

    Friday, July 21, 2017 9:53 AM
  • Hi Terry,

    Thanks for the reply. I don't quite follow your answer. My level of programming is rookie lol. Could you elaborate on it? I don't see how it apply's to question. What are there cha?

    Thanks,

    Tuesday, July 25, 2017 2:32 PM
  • I have read up on recursion, but I can't seem to make it work nor understand the code people write. How do I do this?

    Here's one that works with a variable number of elements as input and so the output is also variable.

    Furthermore I don't use recursion, because it's slow.

    But whether you understand my code... read the comments and debug the code.

    Andreas.

    Option Explicit
    
    Sub Main()
      Dim Item, Elements
      Dim All As Collection
      Dim i As Long
      
      'Setup the elements in an array
      Elements = Array("A", "B", "C", "D", "E", "F")
      
      'Create all combinations
      Set All = CombinationsL(Elements)
      'Loop through the result
      '  Note: each Item is an array with elements
      For Each Item In All
        'Next row
        i = i + 1
        'Write into the sheet
        Cells(i, 1) = Join(Item, "")
      Next
    End Sub
    
    Private Function CombinationsL(Arr) As Collection
      'Return all possible combinations of count elements in Arr as arrays in a collection
      Dim Index() As Long
      Dim Result()
      Dim i As Long, j As Integer, k As Integer, Count As Long
      'Create a collection
      Set CombinationsL = New Collection
      'Return empty collection if Count exceed the bound's of Arr
      If UBound(Arr) < LBound(Arr) Then Exit Function
      Count = UBound(Arr) - LBound(Arr) + 1
      'Setup space for index and result array
      ReDim Index(1 To Count) As Long
      For k = 1 To Count
        ReDim Result(1 To k)
        'Setup index for first combination
        For i = 1 To k
          Index(i) = LBound(Arr) + i - 1
        Next
        Do
          'Build combination
          For i = 1 To k
            Result(i) = Arr(Index(i))
          Next
          'Save it
          CombinationsL.Add Result
          'Get next index
          i = k
          j = 0
          Do
            'Max. position for this index reached?
            If Index(i) = UBound(Arr) - k + i Then
              j = j + 1
              'Move index before up one step in next loop
              i = i - 1
              If i < 1 Then GoTo NextCount
            Else
              'Increment position
              Index(i) = Index(i) + 1
              'Setup next indices
              For j = 1 To j
                i = i + 1
                Index(i) = Index(i - 1) + 1
              Next
              Exit Do
            End If
          Loop
        Loop
    NextCount:
      Next
    End Function
    

    Tuesday, July 25, 2017 4:01 PM
  • Hi Gradient127,

    Has your original issue been resolved? If it has, I would suggest you mark the helpful reply or provide your solution and then mark it as answer to close this thread. 
    If not, please feel free to let us know your current issue.

    Best Regards,

    Terry

    Thursday, August 3, 2017 8:47 AM