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?

 

[Alex Blakenburg]

@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.

Thanks Johnny, it was quite a while ago and seem to have not crossed out my old figures and I agree with your 65,536. Your results agree with my previous findings that it gives the impression of recycling the numbers.
From what I gather, if the item count is over 65,536 it only allocates the New Array the size of mod(ubound(original_array), 65,536) and fills from record 1 to that number and just drops the rest.

 

[johnnyL]

I guess:

    TransposeRowResult = UBound(original_array, 1) Mod 65536

 

[mmhill]

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.

Your first question was "Can it be improved upon?" The answer is: Yes, depending on the use case and how you define "improved." It's not the answer you wanted, so you do you, Boo.

 

[johnnyL]

Your first question was "Can it be improved upon?" The answer is: Yes, depending on the use case and how you define "improved." It's not the answer you wanted, so you do you, Boo.

Sorry, I don't recognize that response.