VBA Use two 1 dimensional arrays to create 2 dimensional array and call value to populate arguments

Question

I have 2 arrays that I want to combine into a single array of all possible combinations. I then need to loop through all of the combinations and popular arguments for a function. My arrays are not equal in size, and my attempts so far have resulted in a combined array only having 1 pair of values. This is VBA in PowerPoint, not Excel, if that makes a difference to available syntax.

How can I go from this:

arrayColor = Array("Blue","Green","Red")
arraySize = Array("XS","S","M","L","XL")

To this:

arrayCombo(0,0) = "Blue"
arrayCombo(0,1) = "XS"
arrayCombo(1,0) = "Blue"
arrayCombo(1,1) = "S"
...
arrayCombo(15,0) = "Red"
arrayCombo(15,1) = "XL"

And then use a loop to call each pair of values and populate argument values. This code just to illustrate the concept; it's certainly not legit. Pretty sure I need a nested loop here?

For i = 0 To UBound(arrayCombo(i))  
    nextSubToFire(color, size)
Next i

---

This is what I've got so far, but it only results in a single pair in my combined array. It's based on this question, but I think I'm either missing something or the sole answer there isn't quite correct. I've looked at other similar questions, but can't wrap my head around doing this with an array compiled in the code rather than the other examples all tailored to Excel.

Option Explicit
Dim arrayColorSize, arrayCombo

Sub CoreRoutine()
    Dim arrayColor, arraySize
    arrayColor = Array("Blue","Green","Red")
    arraySize = Array("XS","S","M","L","XL")
    arrayColorSize = Array(arrayColor, arraySize)
    arrayCombo = Array(0, 0)
    DoCombinations (0)
    Dim a As Integer
    Dim b As Integer
    'For loop comes next once I figure out how to populate the full arrayCombo
    
End Sub

Sub DoCombinations(ia)
    Dim i
    For i = 0 To UBound(arrayColorSize(ia)) ' for each item
        arrayCombo(ia) = arrayColorSize(ia)(i) ' add this item
        If ia = UBound(arrayColorSize) Then
        Else
            DoCombinations (ia + 1)
        End If
    Next i
End Sub

Using the Locals window, I see arrayCombo exists, but it only has 1 pair of values in it, which is the last set of pairing options. I see that arrayColorSize has the 2 array sets as I'd expect, so I suspect the DoCombinations sub is missing something.

Any guidance much appreciated!

Answer 1

One way of doing this is to combine the two 1D arrays into a 2D array with 2 columns (as in your example):

Private Function Combine1DArrays(ByRef arr1 As Variant, ByRef arr2 As Variant) As Variant
    If GetArrayDimsCount(arr1) <> 1 Or GetArrayDimsCount(arr2) <> 1 Then
        Err.Raise 5, "Combine1DArrays", "Expected 1D arrays"
    End If
    '
    Dim count1 As Long: count1 = UBound(arr1) - LBound(arr1) + 1
    Dim count2 As Long: count2 = UBound(arr2) - LBound(arr2) + 1
    Dim i As Long, j As Long, r As Long
    Dim result() As Variant
    '
    ReDim result(0 To count1 * count2 - 1, 0 To 1)
    r = 0
    For i = LBound(arr1) To UBound(arr1)
        For j = LBound(arr2) To UBound(arr2)
            result(r, 0) = arr1(i)
            result(r, 1) = arr2(j)
            r = r + 1
        Next j
    Next i
    Combine1DArrays = result
End Function

Public Function GetArrayDimsCount(ByRef arr As Variant) As Long
    Const MAX_DIMENSION As Long = 60
    Dim dimension As Long
    Dim tempBound As Long
    '
    On Error GoTo FinalDimension
    For dimension = 1 To MAX_DIMENSION
        tempBound = LBound(arr, dimension)
    Next dimension
FinalDimension:
    GetArrayDimsCount = dimension - 1
End Function

You can use it like this for example:

Sub CoreRoutine()
    Dim arrayColorSize As Variant
    Dim i As Long
    Dim color As String
    Dim size As String
    '
    arrayColorSize = Combine1DArrays(Array("Blue", "Green", "Red") _
                                   , Array("XS", "S", "M", "L", "XL"))
    For i = LBound(arrayColorSize, 1) To UBound(arrayColorSize, 1)
        color = arrayColorSize(i, 0)
        size = arrayColorSize(i, 1)
        NextSubToFire color, size
    Next i
End Sub

Sub NextSubToFire(ByVal color As String, ByVal size As String)
    Debug.Print color, size
End Sub