VBA 3D Array - remove rows in two dimensions

[Vinci2504]

Hi Eweryone,

It my first post on the forum, but I am reading forum from long time. Is nice to have a that good kind of support. Always trying solve problems myself, but I have the problem with 3D array.

I am preparing the app to remove rows from 3D array in which conditions is fulfill.
I have the error from app in line: NewArray(col, rowNew, 0) = BaseArray(col, row, 0) ' Error: Subscript out of range
Is someone who can support in this case?

The table is looks like:

Row/Col	11	12	13	....	21
1	1 / RND	1 / RND	1 / RND	1 / RND	1 / RND
2	2 / RND	2 / RND	2 / RND	2 / RND	2 / RND
....	... / RND	... / RND	... / RND	... / RND	... / RND
10	10 / RND	10 / RND	10 / RND	10 / RND	10 / RND

The code is:

'App for preparation of 3D Array
'Column = 11:21
'Row = 1:10
'dimension 0: Row
'Dimension 1: Int(50 * Rnd) + 1
Sub ArrayTestRemove2()

Dim BaseArray(11 To 21, 1 To 10, 1)    ' Declare array variables.
Dim NewArray As Variant
'Dim i, j, j1, k As Long
Dim col, row, rowNew As Long

'--- Print
Debug.Print "Minimum number of Row: "; LBound(BaseArray, 2) 'Minimum number of Row
Debug.Print "Maximum number of Row: "; UBound(BaseArray, 2) 'Maximum number of Row
Debug.Print "Minimum number of Col: "; LBound(BaseArray, 1) 'Minimum number of Row
Debug.Print "Maximum number of Col: "; UBound(BaseArray, 1) 'Maximum number of Row
    
'--- Prepare Array in two dimensions (col, row, page)
    For col = LBound(BaseArray, 1) To UBound(BaseArray, 1)
        For row = LBound(BaseArray, 2) To UBound(BaseArray, 2)
            BaseArray(col, row, 0) = row
            BaseArray(col, row, 1) = row & "." & Int(50 * Rnd) + 1
        Next row
    Next col
    
'--- print Array
    For row = LBound(BaseArray, 2) To UBound(BaseArray, 2)
        For col = LBound(BaseArray, 1) To UBound(BaseArray, 1)
           Debug.Print col; row; "|"; BaseArray(col, row, 0); BaseArray(col, row, 1)
           'Debug.Print MyArray(i, j, 1)
        Next col
    Next row
    
'--- Print
Debug.Print "Array(col=1, row=10, page=0): "; BaseArray(11, 10, 0)

'--- Remove rows when Value in Column 11 > 9 in both dimensions
ReDim NewArray(LBound(BaseArray, 2) To UBound(BaseArray, 2))
rowNew = 1
    For row = 1 To UBound(BaseArray, 2)
        For col = LBound(BaseArray, 1) To UBound(BaseArray, 1)
            If BaseArray(11, row, 0) <> 9 Then
                rowNew = rowNew + 1
                NewArray(col, rowNew, 0) = BaseArray(col, row, 0) ' Error: Subscript out of range
                NewArray(col, rowNew, 1) = BaseArray(col, row, 1)
            End If
        Next col
    Next row
ReDim Preserve NewArray(LBound(BaseArray, 2) To rowNew)
    
'--- Finish
Debug.Print "Done"

End Sub

 

[Fluff]

Hi & welcome to MrExcel.
This line ReDim NewArray(LBound(BaseArray, 2) To UBound(BaseArray, 2)) will give you a 1d array of 1 to 10
but you are referring to it as though it was a 3d array.

 

[Vinci2504]

Thank you for feedback. I overlooked definition of boundlist.

I make some modification based on your feedback, but I can't still get 'Redim Preverse' to the correct result.

Current code is working until 'ReDim Preserve NewArray(11 To 21, LBound(NewArray, 2) To rowNew, 1)'.
Everything is working as I expect, but still 'empty' rows are not removed.
Any idea?

'App for preparation of 3D Array
'Column = 11:21
'Row = 1:10
'dimension 0: Row
'Dimension 1: Int(50 * Rnd) + 1
Sub ArrayTestRemove2()

Dim BaseArray(11 To 21, 1 To 10, 1)    ' Declare array variables.
Dim NewArray As Variant
'Dim i, j, j1, k As Long
Dim col, row, rowNew As Long

'--- Print
Debug.Print "Minimum number of Row: "; LBound(BaseArray, 2) 'Minimum number of Row
Debug.Print "Maximum number of Row: "; UBound(BaseArray, 2) 'Maximum number of Row
Debug.Print "Minimum number of Col: "; LBound(BaseArray, 1) 'Minimum number of Col
Debug.Print "Maximum number of Col: "; UBound(BaseArray, 1) 'Maximum number of Col
    
'--- Prepare Array in two dimensions (col, row, page)
    For col = LBound(BaseArray, 1) To UBound(BaseArray, 1)
        For row = LBound(BaseArray, 2) To UBound(BaseArray, 2)
            BaseArray(col, row, 0) = row
            BaseArray(col, row, 1) = row & "." & Int(50 * Rnd) + 1
        Next row
    Next col
    
'--- print Array
    For row = LBound(BaseArray, 2) To UBound(BaseArray, 2)
        For col = LBound(BaseArray, 1) To UBound(BaseArray, 1)
           Debug.Print col; row; "|"; BaseArray(col, row, 0); BaseArray(col, row, 1)
           'Debug.Print MyArray(i, j, 1)
        Next col
    Next row
    
'--- Print
Debug.Print "Array(col=1, row=10, page=0): "; BaseArray(11, 10, 0)

'--- Remove rows when Value in Column 11 > 9 in both dimensions
'ReDim NewArray(LBound(BaseArray, 2) To UBound(BaseArray, 2))
'ReDim NewArray(11 To 21, LBound(BaseArray, 2) To UBound(BaseArray, 2), 0)
ReDim NewArray(11 To 21, LBound(BaseArray, 2) To UBound(BaseArray, 2), 0 To 1)
rowNew = 0
    'For col = LBound(BaseArray, 1) To UBound(BaseArray, 1) ' 11 To 21
        For row = LBound(BaseArray, 2) To UBound(BaseArray, 2) ' 1 to 10
            If BaseArray(11, row, 0) <> 9 Then
                rowNew = rowNew + 1
                For col = LBound(BaseArray, 1) To UBound(BaseArray, 1) ' 11 To 21
                    NewArray(col, rowNew, 0) = BaseArray(col, row, 0)
                    NewArray(col, rowNew, 1) = BaseArray(col, row, 1)
                Next col
            End If
        Next row
    'Next col
    
'--- Print support
Debug.Print LBound(NewArray, 2)
Debug.Print rowNew

'Redefine Array size
ReDim Preserve NewArray(11 To 21, LBound(NewArray, 2) To rowNew, 1)
 
'--- Finish
Debug.Print "Redim Preserve has been done"

End Sub

 

[Rick Rothstein]

I make some modification based on your feedback, but I can't still get 'Redim Preverse' to the correct result.

When using ReDim, you can only change the limits of the last dimension... your code is attempting to change the limits of the next to last dimension.