Visual Basic > API and Miscellaneous

Redim Preserve a 2d array

Redim Preserve a 2d array

To redim preserve the first element of a 2d array, use the following code:

'Purpose   :    A ReDim Preserve routine for a 2-d array
'Inputs    :    vaValues                Array to resize
'               lLBound                 The New LBound of the first element of the 2d Array
'               lUBound                 The New UBound of the first element of the 2d Array
'Outputs   :
'Notes     :    Doesn't work with fixed arrays


Sub ReDimPreserve2d(ByRef vaValues As Variant, lLBound As Long, lUBound As Long)
    Dim lThisRow As Long, lThisCol As Long, vaResults() As Variant, lNumDims As Long
    Dim lLBound2 As Long, lUBound2 As Long
    
    On Error GoTo ExitSub
    If IsArray(vaValues) Then
        lNumDims = lUBound - lLBound + 1
        If lNumDims <= 0 Then
            'Delete Array
            On Error Resume Next
            Erase vaValues
            vaValues = Empty
            On Error GoTo 0
        Else
            'Create the Result Array
            lLBound2 = LBound(vaValues, 2)
            lUBound2 = UBound(vaValues, 2)
            ReDim vaResults(lLBound To lUBound, lLBound2 To lUBound2)
            'Copy vaValues into vaResults
            For lThisRow = lLBound2 To lUBound2
                For lThisCol = lLBound To lUBound
                    vaResults(lThisCol, lThisRow) = vaValues(lThisCol, lThisRow)
                Next
            Next
            'Copy Result array to input array
            On Error GoTo ArrayDimmed
            vaValues = vaResults
        End If
    End If
    GoTo ExitSub
    
ArrayDimmed:
    'The Input array has been dimmed as an array,
    'copy each element of Result array to Input array
    ReDim vaValues(lLBound To lUBound, lLBound2 To lUBound2)
    For lThisRow = lLBound2 To lUBound2
        For lThisCol = lLBound To lUBound
            vaValues(lThisCol, lThisRow) = vaResults(lThisCol, lThisRow)
        Next
    Next
    On Error GoTo 0
ExitSub:
End Sub