How to redim multidimensional correctly

[ouvay]

Hello

My code here (posting only error area) gives me subscription out of range error

For i = LBound(l) To UBound(l)
    If l(i, 6) = "Completed" Then
        n = n + 1
        ReDim Preserve a(1 To n) As Variant
        a(n) = l(i, 1)
    End If
Next i

ReDim Preserve a(1 To UBound(a), 1 To 50) As Variant

I know we cannot redim the first dimensions of an array, that is why I wrote it like this.. but unfortunately I cannot expand my array columns

any advice?

 

[StephenCrump]

You can't use Redim Preserve to increase the number of dimensions, e.g. from 1 to 2.

Why don't you just make it big enough in the first place?

Dim a() As Variant

'...

ReDim a(1 To UBound(L) - LBound(L) + 1, 1 To 50)

For i = LBound(L) To UBound(L)
    If L(i, 6) = "Completed" Then
        n = n + 1
        a(n, 1) = L(i, 1)
    End If
Next i

 

[ouvay]

You can't use Redim Preserve to increase the number of dimensions, e.g. from 1 to 2.

Why don't you just make it big enough in the first place?

Dim a() As Variant

'...

ReDim a(1 To UBound(L) - LBound(L) + 1, 1 To 50)

For i = LBound(L) To UBound(L)
    If L(i, 6) = "Completed" Then
        n = n + 1
        a(n, 1) = L(i, 1)
    End If
Next i

Thanks for the quick reply! I was trying to avoid doing that lol wanted to know if there was a more elegant solution which had evaded me but I guess the way arrays work leaves us with few options
Thanks so much coming through and helping!

 

[Alex Blakenburg]

Give this a go:

    a = Application.Transpose(a)
    ReDim Preserve a(1 To UBound(a, 1), 1 To 50)

 

[ouvay]

Give this a go:

    a = Application.Transpose(a)
    ReDim Preserve a(1 To UBound(a, 1), 1 To 50)

You is magic! <3

 

[Alex Blakenburg]

You're welcome. Glad we could help.

 

[johnnyL]

I know we cannot redim the first dimensions of an array, that is why I wrote it like this.. but unfortunately I cannot expand my array columns

any advice?

Actually you can redim both with the help of a UDF. It is past my bedtime, but I will see if I can locate it when I awaken if you want.

 

[ouvay]

Actually you can redim both with the help of a UDF. It is past my bedtime, but I will see if I can locate it when I awaken if you want.

that sounds amazing! no rush though.. get your solid 7 first

 

[johnnyL]

Found it:

Public Function ReDimPreserve(ArrayNameToPreserve, NewRowUbound, NewColumnUbound)
'
' Code inspired by Control Freak
'
' Redim & preserve both dimensions for a 2D array
'
' example usage of the function:
' ArrayName = ReDimPreserve(ArrayName,NewRowSize,NewColumnSize)
' ie.
' InputArray = ReDimPreserve(InputArray,10,20)
'
    ReDimPreserve = False
'
    If IsArray(ArrayNameToPreserve) Then                                                                    ' If the variable is an array then ...
        ReDim NewArrayNameToPreserve(NewRowUbound, NewColumnUbound)                                         '   Create New 2D Array
        OldRowUbound = UBound(ArrayNameToPreserve, 1)                                                       '   Save row Ubound of original array
        OldColumnUbound = UBound(ArrayNameToPreserve, 2)                                                    '   Save column Ubound of original array
'
        For NewRow = LBound(ArrayNameToPreserve, 1) To NewRowUbound                                         '   Loop through rows of original array
            For NewColumn = LBound(ArrayNameToPreserve, 2) To NewColumnUbound                               '       Loop through columns of original array
                If OldRowUbound >= NewRow And OldColumnUbound >= NewColumn Then
                    NewArrayNameToPreserve(NewRow, NewColumn) = ArrayNameToPreserve(NewRow, NewColumn)      '               Append additional rows/columns to NewArrayNameToPreserve
                End If
            Next                                                                                            '       Loop back
        Next                                                                                                '   Loop back
'
        If IsArray(NewArrayNameToPreserve) Then ReDimPreserve = NewArrayNameToPreserve
    End If
End Function

 

[ouvay]

Found it:

Public Function ReDimPreserve(ArrayNameToPreserve, NewRowUbound, NewColumnUbound)
'
' Code inspired by Control Freak
'
' Redim & preserve both dimensions for a 2D array
'
' example usage of the function:
' ArrayName = ReDimPreserve(ArrayName,NewRowSize,NewColumnSize)
' ie.
' InputArray = ReDimPreserve(InputArray,10,20)
'
    ReDimPreserve = False
'
    If IsArray(ArrayNameToPreserve) Then                                                                    ' If the variable is an array then ...
        ReDim NewArrayNameToPreserve(NewRowUbound, NewColumnUbound)                                         '   Create New 2D Array
        OldRowUbound = UBound(ArrayNameToPreserve, 1)                                                       '   Save row Ubound of original array
        OldColumnUbound = UBound(ArrayNameToPreserve, 2)                                                    '   Save column Ubound of original array
'
        For NewRow = LBound(ArrayNameToPreserve, 1) To NewRowUbound                                         '   Loop through rows of original array
            For NewColumn = LBound(ArrayNameToPreserve, 2) To NewColumnUbound                               '       Loop through columns of original array
                If OldRowUbound >= NewRow And OldColumnUbound >= NewColumn Then
                    NewArrayNameToPreserve(NewRow, NewColumn) = ArrayNameToPreserve(NewRow, NewColumn)      '               Append additional rows/columns to NewArrayNameToPreserve
                End If
            Next                                                                                            '       Loop back
        Next                                                                                                '   Loop back
'
        If IsArray(NewArrayNameToPreserve) Then ReDimPreserve = NewArrayNameToPreserve
    End If
End Function

Thanks so much! I'm going to give this a go and get back to you