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!

See also: https://stackoverflow.com/questions/19780016/vba-write-all-possible-combinations-of-4-columns-of-data/19780307#19780307 — Tim Williams, Mar 22 '22 at 01:10
Thanks, @TimWilliams. I'll take another look at that, but I was struggling to interpret that to my scenario (admittedly very weak VBA skills here). I see ReDim (and maybe Preserve) is perhaps what I'm missing with my DoCombinations sub? I think the way I have it written is perhaps overwriting the array with each value until it hits the last one? — BobbyScon, Mar 22 '22 at 01:15

score 1 · Accepted Answer · answered Mar 22 '22 at 11:33

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

Did a quick run with this and it looks like it's working well. Thanks for that! Would you be able to edit your answer and put some comments in the code briefly explaining the various components? — BobbyScon, Mar 22 '22 at 13:07
@BobbyScon To me, the code is self-explanatory hence I did not add any redundant comments. But, if you have any specific question then please ask and I will answer them. In short, the ```Combine1DArrays``` method receives two 1D arrays as input which then checks if they're actually 1D by using the ```GetArrayDimsCount``` function. Then, the ```result``` array is dimensioned as a 2D array with enough rows for all combinations and 2 columns (one for color, one for size). Finally the ```result``` array is populated and returned. In the ```CoreRoutine``` example the 2D array is traversed row-wise — Cristian Buse, Mar 22 '22 at 14:51

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

1 Answers1