How to make lists of all possible combinations in VBA, with variable sized lists

Question

I have a little issue with a VBA project in which I am having an input in the format below:

• a, b, c, d
• e, f
• g, h, i
• l, m, n, o, p

Essentially, what I am trying to get as an output would be a matrix with each possible combination per column, such as:

• a, a, a, a, a, a, a, a, a, a, a, a, a, a, a...
• e, e, e, e, e, e, e, e, e, e, e, e, e, e, e...
• g, g, g, g, g, h, h, h, h, h, i, i, i, i, i...
• l, m, n, o, p, l, m, n, o, p, l, m, n, o, p...

The trick is that there is a variable amount of lines and that the length of each varies from one line to another.

Would anyone have any suggestion on how I could treat the issue? Thanks in advance!

Answer 1

Use an array sized for the number of lines. Increment each element within the bounds of the number of elements of that line. For example a 1D array of 4 elements ar(3). ar(0) increments 0 to 3 (a,b,c,d), ar(1) is 0 to 1 (e,f), ar(2) is 0 to 2 (g,h,i) and ar(3) is 0 to 4 (l,m,n,o,p). Array arN holds for the number of element for a line.

Option Explicit

Sub combinations()

    Dim n As Long, t As Long
    Dim i As Long, j As Long, s As String
    Dim arIn, ar, arN, arSeq
    
    With Sheet1
        ' list in A1:A4
        
        arIn = .Range("A1:A4").Value2
        
        ' determine array sizes
        n = UBound(arIn) - 1
        ReDim arSeq(n)
        ReDim arN(n)
        
        ' fill arrays
        For i = 0 To n
           s = Replace(arIn(i + 1, 1), " ", "")
           arSeq(i) = Split(s, ",")
           arN(i) = UBound(arSeq(i))
        Next
    End With
    
    ' calc total combinations
    t = 1
    For n = 0 To UBound(arN)
       t = t * (arN(n) + 1)
    Next
    MsgBox "Permutations=" & t
   
    ' start at
    ar = Array(0, 0, 0, 0)
    
    ' output results
    With Sheet1
        For j = 1 To t
            For i = 0 To UBound(ar)
                .Cells(i + 1, j + 1) = arSeq(i)(ar(i))
            Next
            ' next sequence
            Call incr(ar, arN)
        Next
    End With

End Sub

Sub incr(ByRef ar, arN)

    Dim i As Long, n As Long
     
    ' increment LH digit
    n = UBound(ar)
    ar(n) = ar(n) + 1
    
    ' check carry overs
    For i = n To 0 Step -1
        If ar(i) > arN(i) Then
            If i = 0 Then
                ' no more
                MsgBox "End"
                End
            End If
            ar(i) = 0
            ' increment prev digit
            ar(i - 1) = ar(i - 1) + 1
        Else
            Exit Sub
        End If
     Next
End Sub