VBA loop to populate Array

Question

I'm looking at populating an array based off columns in an original Excel table. I'm attempting to loop through to iteratively obtain each combination of fields, in order to populate into second Excel table subsequently. Thus far i have populated 5 individual arrays, and obtained the count of the data in them, however its when i attempt to populate the 'calcarray' where i'm encountering issues. When executing I'm getting run-time error '9' subscript out of range on "calcarray(x, 4) = Data5(d)" Any assistance would be appreciated!

Sub populate_table()

Dim Data1() As Variant
Dim Data2() As Variant
Dim Data3() As Variant
Dim Data4() As Variant
Dim Data5() As Variant

Dim Data1Count As Integer
Dim Data2count As Integer
Dim Data3Count As Integer
Dim Data4Count As Integer
Dim Data5Count As Integer

Dim ttl As Long

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim f As Integer
Dim d As Integer

Dim tbl As ListObject
Set tbl = Sheets("Data").ListObjects("tbl_variables")

Data1Count = tbl.ListColumns("Data1").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Count
Data2count = tbl.ListColumns("Data2").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Count
Data3Count = tbl.ListColumns("Data3").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Count
Data4Count = tbl.ListColumns("Data4").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Count
Data5Count = tbl.ListColumns("Data5").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Count

Data1 = Array(tbl.ListColumns("Data1").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Value)
Data2 = Array(tbl.ListColumns("Data2").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Value)
Data3 = Array(tbl.ListColumns("Data3").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Value)
Data4 = Array(tbl.ListColumns("Data4").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Value)
Data5 = Array(tbl.ListColumns("Data5").DataBodyRange.Rows.SpecialCells(xlCellTypeConstants).Value)

ttl = (Data1Count) * (Data2count) * (Data3Count) * (Data4Count) * (Data5Count)

Dim calcarray() As Variant
ReDim calcarray(ttl, 4)

x = 0
For i = 0 To Data1Count
    For j = 0 To Data2count
        For k = 0 To Data3Count
            For f = 0 To Data4Count
                For d = 0 To Data5Count
                        calcarray(x, 0) = Data1(i)
                        calcarray(x, 1) = Data2(j)
                        calcarray(x, 2) = Data3(k)
                        calcarray(x, 3) = Data4(f)
                        calcarray(x, 4) = Data5(d)
                        x = x + 1
                Next
            Next
        Next
    Next
Next

Answer 1

Combination Of Table Column Values

Option Explicit

Sub populateTable()
    
    Const wsName As String = "Data"
    Const tblName As String = "tbl_variables"
    Const HeaderDelimiter As String = ","
    Const HeaderList As String = "Data1,Data2,Data3,Data4,Data5"
    Dim wb As Workbook: Set wb = ThisWorkbook
     
    Dim tbl As ListObject
    Set tbl = wb.Worksheets(wsName).ListObjects(tblName)
    
    Dim Data As Variant
    Data = NonEmptyTableColumnsToArray(tbl, HeaderList, HeaderDelimiter)
    
    Dim LowUp() As Long
    LowUp = JaggedLowerUpper(Data)
    
    Dim rUpper As Long: rUpper = UpperFromLowUp(LowUp)
    Dim cUpper As Long: cUpper = UBound(Data) ' or 'UBound(LowUp, 2)'
    Dim Result As Variant: ReDim Result(0 To rUpper, 0 To cUpper)
    
    Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
    
    For i = LowUp(0, 0) To LowUp(1, 0)
        For j = LowUp(0, 1) To LowUp(1, 1)
            For k = LowUp(0, 2) To LowUp(1, 2)
                For l = LowUp(0, 3) To LowUp(1, 3)
                    For m = LowUp(0, 4) To LowUp(1, 4)
                        Result(n, 0) = Data(0)(i)
                        Result(n, 1) = Data(1)(j)
                        Result(n, 2) = Data(2)(k)
                        Result(n, 3) = Data(3)(l)
                        Result(n, 4) = Data(4)(m)
                        n = n + 1
                    Next m
                Next l
            Next k
        Next j
    Next i
    
'    ' Copy to range.
'    With wb.Worksheets(wsName).Range("N2").Resize(, cUpper + 1)
'        .Resize(.Worksheet.Rows.Count - .Row + 1).ClearContents
'        .Resize(rUpper + 1).Value = Result
'    End With
    
End Sub

Function NonEmptyTableColumnsToArray( _
    tbl As ListObject, _
    ByVal HeaderList As String, _
    Optional ByVal Delimiter As String = ",") _
As Variant
    Dim Headers() As String: Headers = Split(HeaderList, ",")
    Dim Data As Variant: ReDim Data(0 To UBound(Headers))
    Dim n As Long
    With tbl
        For n = 0 To UBound(Headers)
            With .ListColumns(Headers(n)).DataBodyRange
                Data(n) = NonEmpty2DToArray(.Value)
            End With
        Next n
    End With
    NonEmptyTableColumnsToArray = Data
End Function

Function NonEmpty2DToArray( _
    Data As Variant) _
As Variant
    If Not IsEmpty(Data) Then
        With CreateObject("System.Collections.ArrayList")
            Dim i As Long
            For i = 1 To UBound(Data)
                If Not IsEmpty(Data(i, 1)) Then
                    .Add Data(i, 1)
                End If
            Next i
            NonEmpty2DToArray = .ToArray
        End With
    End If
End Function

Function JaggedLowerUpper( _
    Jagged As Variant) _
As Variant
    Dim j As Long: j = LBound(Jagged)
    Dim n As Long: n = UBound(Jagged) - j
    Dim Result() As Long: ReDim Result(0 To 1, 0 To n)
    For n = 0 To n
        Result(0, n) = LBound(Jagged(j))
        Result(1, n) = UBound(Jagged(j))
        j = j + 1
    Next n
    JaggedLowerUpper = Result
End Function

Function UpperFromLowUp( _
    LowUp() As Long) _
As Long
    Dim rUpper As Long: rUpper = 1
    Dim n As Long
    For n = 0 To UBound(LowUp, 2)
         rUpper = rUpper * (LowUp(1, n) - LowUp(0, n) + 1)
    Next n
    UpperFromLowUp = rUpper - 1
End Function

Answer 2

You can't reliably get the Value property of a multi-area range, and if you could then you can't then wrap it in Array() to get an array you can loop over via indexing in a For...Next loop. If you put a watch on your arrays you will see they're likely not as you expect.

Here's one suggestion using a function to transform your table column ranges into an array of values:

Sub populate_table()

    Dim d1, d2, d3, d4, d5
    Dim ttl As Long, x As Long
    Dim i As Long, j As Long, k As Long, f As Long, d As Long
    
    With Sheets("Data").ListObjects("tbl_variables")
        d1 = VisibleCellsArray(.ListColumns("Data1").DataBodyRange) 'see function below
        d2 = VisibleCellsArray(.ListColumns("Data2").DataBodyRange)
        d3 = VisibleCellsArray(.ListColumns("Data3").DataBodyRange)
        d4 = VisibleCellsArray(.ListColumns("Data4").DataBodyRange)
        d5 = VisibleCellsArray(.ListColumns("Data5").DataBodyRange)
    End With
    
    Dim calcarray() As Variant
    ttl = UBound(d1) * UBound(d2) * UBound(d3) * UBound(d4) * UBound(d5)
    ReDim calcarray(1 To ttl, 1 To 5)
    
    x = 1
    For i = 1 To UBound(d1)
        For j = 1 To UBound(d2)
            For k = 1 To UBound(d3)
                For f = 1 To UBound(d4)
                    For d = 1 To UBound(d5)
                            calcarray(x, 1) = d1(i)
                            calcarray(x, 2) = d2(j)
                            calcarray(x, 3) = d3(k)
                            calcarray(x, 4) = d4(f)
                            calcarray(x, 5) = d5(d)
                            x = x + 1
                    Next
                Next
            Next
        Next
    Next
    
    'put on a sheet...
    Sheets("Data").Range("H2").Resize(ttl, 5).Value = calcarray

End Sub

'given a (single-row or -column) range
'  return a 1-based array of the visible cell values
Function VisibleCellsArray(rng As Range)
    Dim rngV As Range, c As Range, rv, i As Long
    Set rngV = rng.SpecialCells(xlCellTypeVisible)
    ReDim rv(1 To rngV.Cells.Count)
    i = 0
    For Each c In rngV.Cells
        i = i + 1
        rv(i) = c.Value
    Next c
    VisibleCellsArray = rv
End Function