Resize rows of a 2D Array

[johnnyL]

This is widely reported as not possible. You can only change the # of columns of a 2D Array.

While technically that is true, the end goal is quickly possible. This is accomplished by quickly copying data from the Original 2D Array to a new 2D Array of the size that is specified.

I got the idea from a post dated 01/09/2014 by Control Freak @ Excel VBA - How to Redim a 2D array?

That is the code I started with for a function to Preserve a current 2D array and be able to resize the # of rows & columns in the 2D Array.

The Function I came up with will preserve the Original 2D array data as well as the LBounds of the Original 2D Array, allow resizing the amount of rows/columns of the Original 2D Array, & Erase the Original 2D Array (Free up memory) prior to the creation of the 'New' preserved/resized 2D Array.

Public Function ReDimPreserve(ArrayNameToResize, NewRowUbound, NewColumnUbound)
'
' Code inspired by Control Freak
'
' Preserve Original data & LBounds & Redim both dimensions for a 2D array
'
' example usage of the function:
' ArrayName = ReDimPreserve(ArrayName,NewRowSize,NewColumnSize)
' ie.
' InputArray = ReDimPreserve(InputArray,10,20)
'
    Dim NewColumn                   As Long, NewRow                      As Long
    Dim OldColumnLbound             As Long, OldRowLbound                As Long
    Dim OldColumnUbound             As Long, OldRowUbound                As Long
    Dim NewResizedArray()           As Variant
'
    ReDimPreserve = False
'
    If IsArray(ArrayNameToResize) Then                                                                      ' If the variable is an array then ...
           OldRowLbound = LBound(ArrayNameToResize, 1)                                                      '   Save the original row Lbound to OldRowLbound
        OldColumnLbound = LBound(ArrayNameToResize, 2)                                                      '   Save the original column Lbound to OldColumnLbound
'
        ReDim NewResizedArray(OldRowLbound To NewRowUbound, OldColumnLbound To NewColumnUbound)             '   Create a New 2D Array with same Lbounds as the original array
'
        OldRowUbound = UBound(ArrayNameToResize, 1)                                                         '   Save row Ubound of original array
        OldColumnUbound = UBound(ArrayNameToResize, 2)                                                      '   Save column Ubound of original array
'
        For NewRow = OldRowLbound To NewRowUbound                                                           '   Loop through rows of original array
            For NewColumn = OldColumnLbound To NewColumnUbound                                              '       Loop through columns of original array
                If OldRowUbound >= NewRow And OldColumnUbound >= NewColumn Then                             '           If more data to copy then ...
                    NewResizedArray(NewRow, NewColumn) = ArrayNameToResize(NewRow, NewColumn)               '               Append rows/columns to NewResizedArray
                End If
            Next                                                                                            '       Loop back
        Next                                                                                                '   Loop back
'
        Erase ArrayNameToResize                                                                             '   Free up the memory the Original array was taking
'
        If IsArray(NewResizedArray) Then ReDimPreserve = NewResizedArray
    End If
End Function

Let me know your thoughts. Can it be improved upon?

 

[mmhill]

Maybe I'm missing something.

If you Dim ayOld(1 to 2, 1 to 2) >>> ReDim ayOld(1 to 2, 1 to 4) works BUT ReDim ayOld(1 to 4, 1 to 2) and ayOld(1 to 4, 1 to 4) both fail.
You can easily ReDim ayOld(1 to 2, 1 to 2) to ayOld(1 to 4, 1 to 4) by using Transpose. No looping necessary.

Sub ReDimBothDimentions()
Dim ayOLD(), ayNEW()

    ReDim ayOLD(1 To 2, 1 To 2)
        ayOLD(1, 1) = 11: ayOLD(1, 2) = 12
        ayOLD(2, 1) = 21: ayOLD(2, 2) = 22
        
    ReDim Preserve ayOLD(1 To 2, 1 To 4)
        ayOLD(1, 3) = 13: ayOLD(1, 4) = 14
        ayOLD(2, 3) = 23: ayOLD(2, 4) = 24
        
    ayNEW = Application.Transpose(ayOLD) << Put into ayNew
    ReDim Preserve ayNEW(1 To 4, 1 To 4) << Static Dimension 1 in ayOld is now Resizeable Dimention 2 in ayNew
        
    ayOLD = Application.Transpose(ayNEW) <<< Put it back
        ayOLD(3, 1) = 31: ayOLD(3, 2) = 32: ayOLD(3, 3) = 33: ayOLD(3, 4) = 34
        ayOLD(4, 1) = 41: ayOLD(4, 2) = 42: ayOLD(4, 3) = 43: ayOLD(4, 4) = 44
    
    Erase ayNEW
    Stop
    
End Sub

 

[Alex Blakenburg]

Maybe I'm missing something.

If you Dim ayOld(1 to 2, 1 to 2) >>> ReDim ayOld(1 to 2, 1 to 4) works BUT ReDim ayOld(1 to 4, 1 to 2) and ayOld(1 to 4, 1 to 4) both fail.
You can easily ReDim ayOld(1 to 2, 1 to 2) to ayOld(1 to 4, 1 to 4) by using Transpose. No looping necessary.

You need to be careful with that, as far as I am aware Transpose has a limit of 26,864 rows.

 

[johnnyL]

You need to be careful with that, as far as I am aware Transpose has a limit of 26,864 rows.

Thus the purpose of the function is clearer. I believe the actual limit is 65,536 rows for transpose.

With the function, it is not as confusing as transposing, making a change to the row size, then transposing it back. The function also allows both rows and columns to be changed in the same line of code.

 

[Alex Blakenburg]

Thus the purpose of the function is clearer. I believe the actual limit is 65,536 rows for transpose.

Did you test it ? My testing capped it at 26,864. Look in the Array Values in the watch window above that number. Ideally dump in a sequential no because I seem to recollect that it might recycle the first 26k numbers once it hits that limit. I won't be at a computer until later today.

 

[johnnyL]

Did you test it ? My testing capped it at 26,864. Look in the Array Values in the watch window above that number. Ideally dump in a sequential no because I seem to recollect that it might recycle the first 26k numbers once it hits that limit. I won't be at a computer until later today.

Actually I didn't even make it that far in the testing before you can see that transpose is messing up the row count ...

Sub TestTranspose()
'
    Dim I           As Long
    Dim TestArray() As Variant, NewTestArray() As Variant
'
    ReDim TestArray(1 To 70000, 1 To 2)
'
    For I = 1 To UBound(TestArray, 1)
        TestArray(I, 1) = I
        TestArray(I, 2) = "Column B"
    Next
'
    Debug.Print TestArray(65536, 1)                         ' This = 65536
    Debug.Print TestArray(65537, 1)                         ' This = 65537
'
    Debug.Print UBound(TestArray, 1)                        ' This = 70000
    Debug.Print UBound(TestArray, 2)                        ' This = 2

    NewTestArray = TestArray
'
    Debug.Print NewTestArray(65536, 1)                         ' This = 65536
    Debug.Print NewTestArray(65537, 1)                         ' This = 65537
'
    Debug.Print UBound(NewTestArray, 1)                        ' This = 70000
    Debug.Print UBound(NewTestArray, 2)                        ' This = 2
'
    NewTestArray = Application.Transpose(NewTestArray)
'
    Debug.Print UBound(NewTestArray, 1)                        ' This = 2
    Debug.Print UBound(NewTestArray, 2)                        ' This = 4464 <---
'
    NewTestArray = Application.Transpose(NewTestArray)
'
    Debug.Print UBound(NewTestArray, 1)                        ' This = 4464 <---
    Debug.Print UBound(NewTestArray, 2)                        ' This = 2
End Sub

Anything above 65536 for the row count, transpose will mess it up by resetting the row count it appears.

 

[johnnyL]

In other words: Rows of 65537 transposes to 1, 65538 transposes to 2, etc.

That explains the transpose result in post #6. 70000 minus 65536 = 4464.

 

[mmhill]

Thus the purpose of the function is clearer. I believe the actual limit is 65,536 rows for transpose.

With the function, it is not as confusing as transposing, making a change to the row size, then transposing it back. The function also allows both rows and columns to be changed in the same line of code.

A 65,000 record limit might be a problem for someone. But, a VBA loop with 65,000 itterations might be, as well. I do agree a function is generally cleaner than leaving it in the middle of a longer bit of work. However, confusion ... like beauty or elegance ... is in the eye of the beholder. I prefer fewer lines and built-in functions over nested loops wrapped in If/Thens. But, to each his own. There's no one right answer.

My function ...

Function ayVoudou(ByRef ayOld, Ur%, Uc%) As Variant
Dim L1%, L2%, U1%, tmp()
    
    L1 = LBound(ayOld, 1): L2 = LBound(ayOld, 2): U1 = UBound(ayOld, 1)
    
    ReDim Preserve ayOld(L1 To U1, L2 To Uc) ' columns
    tmp = Application.Transpose(ayOld)
        
    ReDim Preserve tmp(L2 To Uc, L1 To Ur) 'rows
    ayVoudou = Application.Transpose(tmp)

End Function

 

[johnnyL]

A 65,000 record limit might be a problem for someone. But, a VBA loop with 65,000 itterations might be, as well. I do agree a function is generally cleaner than leaving it in the middle of a longer bit of work. However, confusion ... like beauty or elegance ... is in the eye of the beholder. I prefer fewer lines and built-in functions over nested loops wrapped in If/Thens. But, to each his own. There's no one right answer.

My function ...

Function ayVoudou(ByRef ayOld, Ur%, Uc%) As Variant
Dim L1%, L2%, U1%, tmp()
   
    L1 = LBound(ayOld, 1): L2 = LBound(ayOld, 2): U1 = UBound(ayOld, 1)
   
    ReDim Preserve ayOld(L1 To U1, L2 To Uc) ' columns
    tmp = Application.Transpose(ayOld)
       
    ReDim Preserve tmp(L2 To Uc, L1 To Ur) 'rows
    ayVoudou = Application.Transpose(tmp)

End Function

I didn't see a working example of your latest code, I did see you mention looping as a potential problem?

Here is the code I put together for 1048576 rows & 2 columns:

Sub TestTranspose()
'
    Dim StartTime   As Double
'
    StartTime = Timer
'
    Dim I           As Long
    Dim ayOld() As Variant, NewTestArray() As Variant
'
    ReDim ayOld(1 To 1048576, 1 To 2)
'
    For I = 1 To UBound(ayOld, 1)
        ayOld(I, 1) = I
        ayOld(I, 2) = "Column B"
    Next
'
    NewTestArray = ReDimPreserve(ayOld, 1048576, 2)
'
    Range("A1").Resize(UBound(NewTestArray, 1), UBound(NewTestArray, 2)) = NewTestArray
'
    Debug.Print "Time to complete 1048576 rows of 2D 2 column array looping = " & Timer - StartTime & " seconds."
End Sub

Public Function ReDimPreserve(ArrayNameToResize, NewRowUbound, NewColumnUbound)
'
' Code inspired by Control Freak
'
' Preserve Original data & LBounds & Redim both dimensions for a 2D array
'
' example usage of the function:
' ArrayName = ReDimPreserve(ArrayName,NewRowSize,NewColumnSize)
' ie.
' InputArray = ReDimPreserve(InputArray,10,20)
'
    Dim NewColumn                   As Long, NewRow                      As Long
    Dim OldColumnLbound             As Long, OldRowLbound                As Long
    Dim OldColumnUbound             As Long, OldRowUbound                As Long
    Dim NewResizedArray()           As Variant
'
    ReDimPreserve = False
'
    If IsArray(ArrayNameToResize) Then                                                                      ' If the variable is an array then ...
           OldRowLbound = LBound(ArrayNameToResize, 1)                                                      '   Save the original row Lbound to OldRowLbound
        OldColumnLbound = LBound(ArrayNameToResize, 2)                                                      '   Save the original column Lbound to OldColumnLbound
'
        ReDim NewResizedArray(OldRowLbound To NewRowUbound, OldColumnLbound To NewColumnUbound)             '   Create a New 2D Array with same Lbounds as the original array
'
        OldRowUbound = UBound(ArrayNameToResize, 1)                                                         '   Save row Ubound of original array
        OldColumnUbound = UBound(ArrayNameToResize, 2)                                                      '   Save column Ubound of original array
'
        For NewRow = OldRowLbound To NewRowUbound                                                           '   Loop through rows of original array
            For NewColumn = OldColumnLbound To NewColumnUbound                                              '       Loop through columns of original array
                If OldRowUbound >= NewRow And OldColumnUbound >= NewColumn Then                             '           If more data to copy then ...
                    NewResizedArray(NewRow, NewColumn) = ArrayNameToResize(NewRow, NewColumn)               '               Append rows/columns to NewResizedArray
                End If
            Next                                                                                            '       Loop back
        Next                                                                                                '   Loop back
'
        Erase ArrayNameToResize                                                                             '   Free up the memory the Original array was taking
'
        If IsArray(NewResizedArray) Then ReDimPreserve = NewResizedArray
    End If
End Function

It completes successfully in about 1.4 seconds on my computer.

 

[johnnyL]

Did you test it ? My testing capped it at 26,864. Look in the Array Values in the watch window above that number. Ideally dump in a sequential no because I seem to recollect that it might recycle the first 26k numbers once it hits that limit. I won't be at a computer until later today.

@Alex Blakenburg back to your question, if the original rows are 65536 or less, the transpose did not screw up the results in my testing.