Awesome

Functions

#back



Resize Array Bounds

This Function allows you to dynamically Resize both Array Bounds of data in a Variant Array ie. Rows and Columns - here is the Code including an Example Subroutine 'ResizeArrayBoundsExample'. This is similar to doing a Redim Preserve but both Subscripts can be resized at the same time - requires Option Base 1:

Option Explicit
Option Base 1

Sub ResizeArrayBoundsExample()

    ' // vars
    Dim vntData As Variant

    ' // pick up some data (let's assume 5 Rows by 3 Columns)
    vntData = Range(Range("A1:C" & Range("A1").End(xlDown).Row).Address).Cells

    ' // resize the array to 10 Rows by 5 Columns
    vntData = Resize(vntData, 10, 5)

End Sub

' /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
' ## Resize
' /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Function Resize(ByVal Jagged As Variant, Optional NumberOfRows As Long = 1, Optional NumberOfColumns As Integer = 1) As Variant
    Dim lngX As Long
    Dim lngY As Long
    Dim lngX1 As Long
    Dim lngY1 As Long
    Dim lngRows As Long
    Dim intColumns As Integer
    Dim lngMaxBound As Long
    ReDim br(NumberOfRows, NumberOfColumns)
    ' // an acceptable method of handling & obtaining jagged array bounds
    On Error GoTo CatchRows
    For lngMaxBound = 1 To 60000
        lngRows = UBound(Jagged, lngMaxBound) - LBound(Jagged, lngMaxBound) + 1
        If lngMaxBound = 1 Then Exit For
    Next lngMaxBound
CatchRows:
    On Error GoTo CatchColumns
    For lngMaxBound = 1 To 60000
        intColumns = UBound(Jagged, lngMaxBound) - LBound(Jagged, lngMaxBound) + 1
        If lngMaxBound = 2 Then Exit For
    Next lngMaxBound
CatchColumns:
    On Error GoTo 0
    ' // populate the resized array
    If NumberOfColumns > intColumns Then lngX1 = intColumns Else lngX1 = NumberOfColumns
    If NumberOfRows > lngRows Then lngY1 = lngRows Else lngY1 = NumberOfRows
    For lngX = 1 To lngX1
        For lngY = 1 To lngY1
            br(lngY, lngX) = Jagged(lngY, lngX)
        Next lngY
    Next lngX
    Resize = br
End Function