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

Time:03-24

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 Locals screenshot

Any guidance much appreciated!

CodePudding user response:

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
  • Related