Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Excel VBA - How do you add a row to a 2d variant array while preserving old array values?

I have tried and looked everywhere. Cannot figure this out. I have a 1 row table with 7 columns and I am reading the values into an array.

Then I want to add a row at some point in my code to that array, while preserving the old values from the array. Here is the code:

Dim arr As Variant

arr = Worksheets(worksheet).ListObjects(table).DataBodyRange

This "arr" is now a 2d array, with 1 row and 7 columns and it loads the data fine.

Later on in my code I want to add a row to this array so I try this:

ReDim Preserve arr(1 To 2, 1 To 7) As Variant

Gives me a "subscript out of range" error.

How do add a row to this type of array while preserving the other values in it?

Thanks all. This is driving me crazy.

like image 861
Chris Lundrigan Avatar asked Mar 20 '26 13:03

Chris Lundrigan


1 Answers

Alternative via Application.Index() function

Just to show another approach in addition to @norie 's valid solution, I demonstrate how to profit from the advanced restructuring features of Application.Index():

Sub ExampleCall()
    Dim arr As Variant
    arr = Sheet1.ListObjects("Table").DataBodyRange   ' << change to your needs
    'add one new array row
    AddRowsToArr arr, 1                               ' << call help procedure
    
    Debug.Print "New dimension: arr(" & _
        LBound(arr, 1) & " To " & UBound(arr, 1) & ", " & _
        LBound(arr, 2) & " To " & UBound(arr, 2) & ")"
    Debug.Print arr(UBound(arr), 2)
End Sub

Help procedure AddRows

Sub AddRowsToArr(arr, Optional ByVal nRows As Long = 1, Optional overwrite As Boolean = True)
'define arrays of needed row and column numbers
    Dim r, c
    r = Evaluate("row(1:" & CStr(nRows + UBound(arr) - LBound(arr) + 1) & ")")
    c = Application.Transpose(Evaluate("row(1:" & CStr(UBound(arr, 2) - LBound(arr, 2) + 1) & ")"))
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'redimension array to new size
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    arr = Application.Index(arr, r, c)

    '*) optional overwriting added row elements with Empty ~~> see Note below!
    '...
End Sub

Note If you want to return empty elements in the added row(s), overwrite the added row elements (containing temporary error values) by inserting the following code lines*; of course you could enter values in the calling procedure, too.*

    'overwrite added row elements with Empty
    If overwrite Then
        Dim rowNum As Long, colNum As Long
        For rowNum = UBound(arr) - nRows + 1 To UBound(arr)
            For colNum = LBound(arr, 2) To UBound(arr, 2)
                arr(rowNum, colNum) = Empty
            Next colNum
        Next rowNum
    End If
like image 100
T.M. Avatar answered Mar 22 '26 04:03

T.M.



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!