Write an Array of Arrays to a Range VBA

Viewed 119

I know there is a method for writing the values of a 2 dim array to a range using

Dim arr(r_len, c_len) As Variant

' Fill in arr

range = arr

However, is there a way to accomplish this using an array of arrays? Currently I have

Dim arr(r_len) As Variant
Dim i As Integer

For i = 0 To UBound(arr)
    arr(i) = Function()
Next i

where Function returns an array of length c_length. However, when I try writing to the range, the cells in the excel sheet remain empty. I have tested using the first way and it worked. Is writing to the range only possible using an explicitly 2 dim array?

3 Answers

It's not so widely known and may be a new point to many contributors that one can execute the Index function upon a jagged array by passing a double zero argument as row and column indices.

   Application.Index(jagged, 0, 0)  

Example code

Note that it's necessary to provide for identical number of array elements within the container array (c.f. Shoebagel's comment). Of course you can enter the example data also sequentially.

Sub WriteJagged()
    Dim jagged() As Variant
'a) fill jagged array e.g. with 2 "rows" of sample data (4 columns each row)
    jagged = Array(Array(1, 2, 3, 4), Array(11, 12, 13, 14))
'b) write jagged to target
    Sheet1.Range("A1").Resize(2, 4) = Application.Index(jagged, 0, 0)
End Sub

Caveat

This approach reveals to be time consuming for greater data sets where I'd prefer the way @ScottCraner demonstrated.

best is to iterate the array returned by the function and place the values in a 2D array:

Sub kjlkjlkj()
    Dim r_len As Long
    r_len = 10
    
    Dim c_len As Long
    c_len = 10
    
    Dim arr() As Variant
    ReDim arr(1 To r_len, 1 To c_len)
    
    Dim i As Long
    For i = 1 To r_len
        Dim arr2() As Variant
        arr2 = fnct(c_len)
        Dim j As Long
        For j = 1 To c_len
            arr(i, j) = arr2(j) + ((i - 1) * c_len)
        Next j
    Next i
    
    ActiveSheet.Range("A1:J10").Value = arr
End Sub
Function fnct(c_len As Long) As Variant()
    Dim temp() As Variant
    ReDim temp(1 To c_len)
    Dim k As Long
    For k = 1 To c_len
        temp(k) = k
    Next k
    fnct = temp
End Function

Write the Values From the Arrays in a Jagged Array to Rows of a Range

The Function

  • It is assumed that the jagged array is one-dimensional and each of its elements contains a one-dimensional array of any reasonable size or limits.
Function GetJaggedArrayInRows( _
    ByVal sJag As Variant) _
As Variant
   
    ' Write the limits of the source jagged array ('sJag')
    ' to variables ('jLower', 'jUpper').
    Dim jLower As Variant: jLower = LBound(sJag)
    Dim jUpper As Variant: jUpper = UBound(sJag)
    
    ' Calculate the destination number of rows ('drCount').
    Dim drCount As Long: drCount = jUpper - jLower + 1
    
    ' Define a 2D one-based two-column array, the lower-upper array ('luData'),
    ' to populate it with each array's lower and upper limits
    ' in each row ('dr'), and at the same time determine the size of the largest
    ' array i.e. the number of columns of the destination array ('dcCount')
    
    Dim luData() As Long: ReDim luData(1 To drCount, 1 To 2)
    
    Dim j As Long
    Dim dr As Long
    Dim dc As Long
    Dim dcCount As Long
    
    For j = jLower To jUpper
        dr = dr + 1
        luData(dr, 1) = LBound(sJag(j))
        luData(dr, 2) = UBound(sJag(j))
        dc = luData(dr, 2) - luData(dr, 1) + 1
        If dc > dcCount Then dcCount = dc
    Next j
    dr = 0 ' reset to later use in similar fashion ('dr = dr + 1').
    
    ' Define the destination array ('dData').
    Dim dData() As Variant: ReDim dData(1 To drCount, 1 To dcCount)
    
    ' Using the information in the lower-upper array,
    ' write the values from the source jagged array to the destination array.
    
    Dim dcOffset As Long
    
    For j = jLower To jUpper
        dr = dr + 1
        dcOffset = 1 - luData(dr, 1)
        For dc = luData(dr, 1) To luData(dr, 2)
            dData(dr, dc + dcOffset) = sJag(j)(dc)
        Next dc
    Next j
    
    ' Assign the destination array to the result of the function.
    GetJaggedArrayInRows = dData

End Function

Example1

Sub GetJaggedArrayInRowsTEST()

    ' Using the Array function, define and populate a 1D array,
    ' the source jagged array ('sJag') containing three 1D arrays.
    Dim sJag() As Variant
    sJag = Array(Array(1, 2, 3), Array(4, 5, 6, 7), Array(1, 2))

    ' Write the values from each array of the source jagged array
    ' to the rows of a 2D one-based array, the destination array ('dData').
    Dim dData() As Variant: dData = GetJaggedArrayInRows(sJag)
    
    ' Reference the destination worksheet ('dws').
    Dim dws As Worksheet: Set dws = ActiveSheet ' improve!
    
    ' Reference the destination first cell ('dfCell').
    Dim dfCell As Range: Set dfCell = dws.Range("A1")
    
    ' Clear the destination area, the range from the first cell
    ' to the last worksheet cell (in this case 'A1:XFD1048576').
    'dfCell.Resize(dws.Rows.Count - dfCell.Row + 1, _
        dws.Columns.Count - dfCell.Column + 1).Clear
    
    ' Reference the destination range ('drg').
    Dim drg As Range
    Set drg = dfCell.Resize(UBound(dData, 1), UBound(dData, 2))
    
    ' Write the values from the destination array to the destination range.
    drg.Value = dData

End Sub

Result of Both Examples

enter image description here

Example2

Sub GetJaggedArrayInRowsBoundsTEST()

    ' Define and populate three 1D arrays ('Arr1', 'Arr2' ,'Arr3').
    Dim Arr1() As Variant: ReDim Arr1(5 To 7) ' 3 elements
    Dim Arr2() As Variant: ReDim Arr2(2 To 5) ' 4 elements
    Dim Arr3() As Variant: ReDim Arr3(9 To 10) ' 2 elements
    Arr1(5) = 1
    Arr1(6) = 2
    Arr1(7) = 3
    Arr2(2) = 4
    Arr2(3) = 5
    Arr2(4) = 6
    Arr2(5) = 7
    Arr3(9) = 8
    Arr3(10) = 9
    
    ' Define a 1D array of 3 elements, the source jagged array ('sJag')
    ' and populate it with the three arrays.
    Dim sJag() As Variant: ReDim sJag(3 To 5)
    sJag(3) = Arr1
    sJag(4) = Arr2
    sJag(5) = Arr3
    
    ' Write the values from the jagged array
    ' to a 2D one-based array, the destination array ('dData').
    Dim dData() As Variant: dData = GetJaggedArrayInRows(sJag)
    
    ' Reference the destination worksheet ('dws').
    Dim dws As Worksheet: Set dws = ActiveSheet ' improve!
    
    ' Reference the destination first cell ('dfCell').
    Dim dfCell As Range: Set dfCell = dws.Range("A1")
    
    ' Clear the destination area, the range from the first cell
    ' to the last worksheet cell (in this case 'A1:XFD1048576').
    'dfCell.Resize(dws.Rows.Count - dfCell.Row + 1, _
        dws.Columns.Count - dfCell.Column + 1).Clear
    
    ' Reference the destination range ('drg').
    Dim drg As Range
    Set drg = dfCell.Resize(UBound(dData, 1), UBound(dData, 2))
    
    ' Write the values from the destination array to the destination range.
    drg.Value = dData

End Sub
Related