Storing data in 2D array

[Formula11]

I'm using a 2D dynamic array, for data in rows and columns.
The number of rows increases/decreases.

The array data doesn't seem to be stored. For code line "MsgBox my_arr(2, 2)", a blank appears.

Not sure if this is the reason:
With multidimensional dynamic arrays, only the last dimension can be increased, unless you use a workaround, such as from here:
Dynamic Array with ReDim Preserve VBA - wellsr.com
This is included below.

Heading 1	Heading 2	Heading 3	Heading 4
Area 1	Apples	Pears	Oranges
Area 1	Watermelon	Nectarines	Lemons
Area 3	Rockmelon	Oranges	Nectarines
Area 4	Pears	Watermelon	Rockmelon
Area 5	Lemons	Oranges	Rockmelon
Area 5	Nectarines	Lemons	Watermelon

Option Explicit

Dim my_arr() As Variant

Sub two_D_array()
    Dim my_row As Long, last_row As Long, last_col As Long
    Dim i As Long
    Application.ScreenUpdating = False
Debug.Print String(65535, vbCr)
    last_row = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    last_col = ActiveSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    ReDim my_arr(0, 0): ReDim my_arr(0, 1): ReDim my_arr(0, 2): ReDim my_arr(0, 3)
    'Data
    '----
    i = 0
    For my_row = 1 To last_row
        'populate arrays
        my_arr(i, 0) = Cells(i + 1, 1).Value: Debug.Print my_arr(i, 0)
        my_arr(i, 1) = Cells(i + 1, 2).Value: Debug.Print my_arr(i, 1)
        my_arr(i, 2) = Cells(i + 1, 3).Value: Debug.Print my_arr(i, 2)
        my_arr(i, 3) = Cells(i + 1, 4).Value: Debug.Print my_arr(i, 3)
        'Resize arrays ... roundabout way required ... see function
        ReDim my_arr(i, 0): ReDim my_arr(i, 1): ReDim my_arr(i, 2): ReDim my_arr(i, 3)
        my_arr = redim_pres(my_arr, i + 1, 0): my_arr = redim_pres(my_arr, i + 1, 1): my_arr = redim_pres(my_arr, i + 1, 2): my_arr = redim_pres(my_arr, i + 1, 3)
        i = i + 1
        Debug.Print "-----------"
    Next my_row
    Application.ScreenUpdating = True
    MsgBox my_arr(2, 2)
End Sub

Private Function redim_pres(MyArray As Variant, nNewFirstUBound As Long, nNewLastUBound As Long) As Variant
    Dim i, j As Long
    Dim nOldFirstUBound, nOldLastUBound, nOldFirstLBound, nOldLastLBound As Long
    Dim TempArray() As Variant
    redim_pres = False
    If Not IsArray(MyArray) Then MsgBox "You didn't pass the function an array.", vbCritical, "No Array Detected": End
    nOldFirstUBound = UBound(MyArray, 1): nOldLastUBound = UBound(MyArray, 2)
    nOldFirstLBound = LBound(MyArray, 1): nOldLastLBound = LBound(MyArray, 2)
    ReDim TempArray(nOldFirstLBound To nNewFirstUBound, nOldLastLBound To nNewLastUBound)
    For i = LBound(MyArray, 1) To nNewFirstUBound
        For j = LBound(MyArray, 2) To nNewLastUBound
            If nOldFirstUBound >= i And nOldLastUBound >= j Then
                TempArray(i, j) = MyArray(i, j)
            End If
        Next
    Next
    If IsArray(TempArray) Then redim_pres = TempArray
End

 

[kevin9999]

Just out of curiosity...

Given that you seem to be filling the array directly from the active sheet (which would give you a 2D array in any case) - is there any reason why you don't fill the array en masse? You don't seem to update the array automatically, but rather by running your sub, so what if you did the following instead?

Option Explicit
Sub Test_2D()
    Dim a
    a = Range(Cells(2, 1), Cells(Cells.Find("*", , xlFormulas, , 1, 2).Row, Cells.Find("*", , xlFormulas, , 2, 2).Column))
    
    Debug.Print a(2, 2) '<-- or whatever other test you wanted to try

End Sub

As I said, just curious

 

[Formula11]

Thanks for replying.
The above is simplified in order to show the issue. From a range in the worksheet, there will be many more array elements produced, so that's why I didn't go to the worksheet directly. The number of columns won't change but there will be many more rows.

 

[Formula11]

This gets a bit closer.
For some reason, it stores some elements but not others.

HEADING 1	HEADING 2	HEADING 3	HEADING 4
Area-1	Apples	Pears	Oranges
Area-2	Rockmelon	Oranges	Nectarines
Area-3	Pears	Watermelon	Rockmelon
Area-4	Lemons	Oranges	Rockmelon

Option Explicit

Dim my_2d_arr() As Variant

Sub two_D_array()
    Dim last_row As Long, last_col As Long
    Dim i As Long, j As Long

Debug.Print String(65535, vbCr)

    last_row = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    last_col = ActiveSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    ReDim my_2d_arr(0, 0)
  
    For i = 0 To last_row - 1
        For j = 0 To last_col - 1
            my_2d_arr(i, j) = Cells(i + 1, j + 1).Value: Debug.Print my_2d_arr(i, j)
            my_2d_arr = redim_pres(my_2d_arr, i, j + 1)
        Next j
        my_2d_arr = redim_pres(my_2d_arr, i + 1, j)
Debug.Print "-----------"
    Next i
 
  MsgBox my_2d_arr(0, 0) & " / " & my_2d_arr(0, 1) & " / " & my_2d_arr(0, 2) & " / " & my_2d_arr(0, 3) _
& vbCrLf & my_2d_arr(1, 0) & " / " & my_2d_arr(1, 1) & " / " & my_2d_arr(1, 2) & " / " & my_2d_arr(1, 3) _
& vbCrLf & my_2d_arr(2, 0) & " / " & my_2d_arr(2, 1) & " / " & my_2d_arr(2, 2) & " / " & my_2d_arr(2, 3) _
& vbCrLf & my_2d_arr(3, 0) & " / " & my_2d_arr(3, 1) & " / " & my_2d_arr(3, 2) & " / " & my_2d_arr(3, 3) _
& vbCrLf & my_2d_arr(4, 0) & " / " & my_2d_arr(4, 1) & " / " & my_2d_arr(4, 2) & " / " & my_2d_arr(4, 3)

End Sub

Private Function redim_pres(MyArray As Variant, nNewFirstUBound As Long, nNewLastUBound As Long) As Variant
    Dim i, j As Long
    Dim nOldFirstUBound, nOldLastUBound, nOldFirstLBound, nOldLastLBound As Long
    Dim TempArray() As Variant
    redim_pres = False
    If Not IsArray(MyArray) Then MsgBox "You didn't pass the function an array.", vbCritical, "No Array Detected": End
    nOldFirstUBound = UBound(MyArray, 1): nOldLastUBound = UBound(MyArray, 2)
    nOldFirstLBound = LBound(MyArray, 1): nOldLastLBound = LBound(MyArray, 2)
    ReDim TempArray(nOldFirstLBound To nNewFirstUBound, nOldLastLBound To nNewLastUBound)
    For i = LBound(MyArray, 1) To nNewFirstUBound
        For j = LBound(MyArray, 2) To nNewLastUBound
            If nOldFirstUBound >= i And nOldLastUBound >= j Then
                TempArray(i, j) = MyArray(i, j)
            End If
        Next
    Next
    If IsArray(TempArray) Then redim_pres = TempArray
End Function

 

[kevin9999]

I wouldn't normally fill an array from a sheet one cell at a time, however if I did, it would be something like this.

Option Explicit
Sub Test_2D()
    Dim LRow As Long, LCol As Long, i As Long, j As Long, arr
    
    With ActiveSheet
        LRow = .Cells.Find("*", , xlFormulas, , 1, 2).Row
        LCol = .Cells.Find("*", , xlFormulas, , 2, 2).Column
        ReDim arr(1 To LRow, 1 To LCol)
        
        For i = LBound(arr, 1) To UBound(arr, 1)
            For j = LBound(arr, 2) To UBound(arr, 2)
                arr(i, j) = .Cells(i, j)
            Next j
        Next i
    End With
    
    MsgBox arr(1, 1) & " / " & arr(1, 2) & " / " & arr(1, 3) & " / " & arr(1, 4) _
    & vbCrLf & arr(2, 1) & " / " & arr(2, 2) & " / " & arr(2, 3) & " / " & arr(2, 4) _
    & vbCrLf & arr(3, 1) & " / " & arr(3, 2) & " / " & arr(3, 3) & " / " & arr(3, 4) _
    & vbCrLf & arr(4, 1) & " / " & arr(4, 2) & " / " & arr(4, 3) & " / " & arr(4, 4) _
    & vbCrLf & arr(5, 1) & " / " & arr(5, 2) & " / " & arr(5, 3) & " / " & arr(5, 4)

End Sub

 

[Formula11]

Thanks kevin, the explanation in post #3 was not the best, entries don't come from cells only but are generated by code as well.
Hard to explain, but let's say there is another column for area of each Area. If area is larger than a value, then extra array values are generated.
I mentioned cells only to simplify.

So with a 2D array which is dynamic (variable 1st dim, fixed 2nd dim), can't increase 1st dim unless something like the redim_pres function is used.

In the end, I just assumed the array is transposed to begin with, and increased the 2nd dim.