excel - ReDim Preserving 3D VBA

Question

Problem: I have the following two functions that should effectively ReDim Preserve a 3D array in all dimensions, transposeArray3D and ReDimPreserve3D. However, this wipes any array that passes through these functions even though I try to re-set values in my transpose function. Specifically, when I debug and hover over my temporary arrays with my mouse (t and newArray), excel indicates that the arrays are empty.

Context: This is all part of an attempt to convert files similar to CSVs into excel tables by splitting at essentially 3 delimiters: the 3D array is necessary to keep track of "table number". I'm not understanding why the functions can't read the arrays being passed to them.

I have included the procedure these functions are called from just in case the problem is not in the functions.

Public Function transposeArray3D(arr3d As Variant) As Variant
    Dim x As Variant, y As Variant, z As Variant, xub As Long, yub As Long, zub As Long, newArray As Variant
    xub = UBound(arr3d, 1) 'x,y,z correspond to dim 1,2,3 of the OLD array
    yub = UBound(arr3d, 2)
    zub = UBound(arr3d, 3)
    ReDim newArray(zub, xub, yub)
    For x = 0 To xub     'x-->y, y-->z, z-->x
        For y = 0 To yub
            For z = 0 To zub
                newArray(z, x, y) = arr3d(x, y, z)
                MsgBox (arr3d(x, y, z))
            Next z
        Next y
    Next x
    transposeArray3D = newArray
End Function

Public Function ReDimPreserve3D(arr As Variant, newx As Long, newy As Long, newz As Long) As Variant
    'ReDim Preserves all dimensions of a 3D array--does not mess with original array
    Dim t As Variant, oldx As Long, oldy As Long, oldz As Long
    oldx = UBound(arr, 1)
    oldy = UBound(arr, 2)
    oldz = UBound(arr, 3)
    ReDim t(oldx, oldy, oldz)
    t = arr
    ReDim Preserve t(oldx, oldy, newz)
    t = transposeArray3D(t)
    ReDim Preserve t(newz, oldx, newy)
    t = transposeArray3D(t)
    ReDim Preserve t(newy, newz, newx)
    t = transposeArray3D(t)
    ReDimPreserve3D = t
End Function

'called from:
Sub csv_to_table()
    
    Dim i As Long, j As Long, k As Long, maxRow As Long, test As Long
    Dim tableCount As Long, nr As Long, nc As Long
    Dim table() As Variant
    ReDim table(0, 0, 0)
    Dim temp1 As Variant, temp2 As Variant 'temp array for each table holding the rows pre-splitting by spaces
    
    maxRow = Cells(rows.Count, 1).End(xlUp).Row
    
    For i = 0 To maxRow
    
        If Not IsEmpty(Cells(i + 1, 1).Value) Then
            
            ReDim Preserve table(UBound(table, 1), UBound(table, 2), i)

            nr = countChar(Cells(i + 1, 1).Text, ";")
            ReDim temp1(nr)
            temp1 = Split(Cells(i + 1, 1), ";") 'holds all the rows of the table in an array
            nc = countChar(CStr(temp1(0)), " ")
            ReDim temp2(nc)
            table = ReDimPreserve3D(table, nr, nc, i)
            
            For j = 0 To nr - 1 'row
                
                temp2 = Split(temp1(j), " ")
                
                For k = 0 To nc - 1 'get table columns (separated by spaces)
                    
                    table(j, k, i) = temp2(k)
                    
                Next k
                
                ReDim temp2(nc)
                
            Next j

            Erase temp1, temp2
        
        End If

    Next i
    
    printArray3D (table)
    
End Sub

question from:https://stackoverflow.com/questions/66054936/redim-preserving-3d-vba

Answer 1

just create a temp that is the correct size and fill it from the original.

Public Function ReDimPreserve3D(arr As Variant, newx As Long, newy As Long, newz As Long)
    Dim t() As Variant
    ReDim t(LBound(arr, 1) To newx, LBound(arr, 2) To newy, LBound(arr, 3) To newz)
    
    Dim i As Long
    For i = LBound(arr, 1) To Application.Min(UBound(arr, 1), UBound(t, 1))
          Dim j As Long
          For j = LBound(arr, 2) To Application.Min(UBound(arr, 2), UBound(t, 2))
            Dim k As Long
            For k = LBound(arr, 3) To Application.Min(UBound(arr, 3), UBound(t, 3))
                t(i, j, k) = arr(i, j, k)
            Next k
        Next j
    Next i

    ReDimPreserve3D = t
End Function