Tuesday, 5 April 2011

VBA Array Within An Array

When using VBA, writing anything but the most trivial VBA routines, it is likely that you’ll be using arrays somewhere in your code. This post describes how you can load one array to another and then pull the data out into a worksheet.
It is assumed that you know the basics of VBA arrays.
Sub ArrayWithinAnArray() 
' Procedure : ArrayWithinAnArray
' Author    : Matthew - Zypher.co.uk
' Date      : 27/03/2011
' Purpose   : Load an ID, a data value and an array to an array
'             Then loop through the 1st array loading it’s values to the
'             active worksheet
    Dim i As Integer
    Dim l As Integer
    Dim x As Integer
    Dim y As Integer

    Dim array1(2, 2) As Variant
    Dim array2(1, 1) As Variant

    On Error GoTo ArrayWithinAnArray_Error

    ' Add values into the 1st array
    For i = 0 To 2
        array1(i, 0) = "ID " & i
        array1(i, 1) = "Some Data"

        ' Load values to the 2nd array
        array2(0, 0) = "row1 col1"
        array2(0, 1) = "row1 col2"
        array2(1, 0) = "row2 col1"
        array2(1, 1) = "row2 col2"

        ' Load the 2nd array into the 1st array
        array1(i, 2) = array2
    Next i

    ' Set l as the first row
    l = Cells.SpecialCells(xlCellTypeLastCell).Row + 1

    ' Loop through the first array
    For i = 0 To UBound(array1)
        Cells(l, 1).Value = array1(i, 0)
        Cells(l, 2).Value = array1(i, 1)

        ' Check the 3rd value is an array
        If IsArray(array1(i, 2)) Then

            ' Loop down through the 2nd array
            For x = 0 To UBound(array1(i, 2))

                ' Loop across the 2nd array
                For y = 0 To UBound(array1(i, 2), 2)

                    ' Load the values in the 2nd array to the worksheet
                    Cells(l, y + 3).Value = array1(i, 2)(x, y)

                Next y

                ' Get the current bottom row, then add 1
                l = Cells.SpecialCells(xlCellTypeLastCell).Row + 1
            Next x

        End If

        ' Get the current bottom row, then add 1
        l = Cells.SpecialCells(xlCellTypeLastCell).Row + 1

    Next i

    On Error GoTo 0
    Exit Sub

    ' Add some error handling code here
End Sub

As always, if you have any questions do let us know via the comments section.

No comments:

Post a Comment

Please, no purely anonymous comments, they will be deleted; always use a name for ease of reference by other commenters.