Subscript out of range VBA error when setting an array equal to a range

Question

Currently, I have a range of strings that I would like to be able to enter into an array. However, I'm not sure that it's working and every time I try to do anything with the array, I get a subscript out of range error. I tried just doing a Debug.Print to see if values are going into the array or not but that resulted in the same error. Here's what I have so far..

UsedRow = ActiveWorkbook.Sheets(3).UsedRange.Rows.Count
Dim ProjectCounter As Long
Dim ArrRange As Range

'This determines the number of entries in the array (I know this part works)
i = UsedRow
ProjectCounter = 0
Do While Cells(i, 1).FormulaR1C1 <> vbNullString
    ProjectCounter = ProjectCounter + 1
    i = i - 1
Loop

'Array should have dimensions that match the number of projects
Dim ProjectArray() As Variant
ReDim ProjectArray(ProjectCounter - 1)

'Set range for array to cover
Set ArrRange = ActiveWorkbook.Sheets(3).Range("A" & UsedRow - ProjectCounter & ":A" & UsedRow)

'Populate array with projects
ProjectArray = ArrRange

For i = LBound(ProjectArray) To UBound(ProjectArray)
Debug.Print ProjectArray(i)
Next

Is this the right way to set up an array? And if not, what am I doing incorrectly? Thanks.

Answer 1

I have long considered the way 1-dimensional ranges are copied as 2-dimensional arrays to be one of the most annoying things about VBA. One way to fix the resulting subscript out of range error is to, rather then remembering to include a pointless subscript, first fix the array itself so that if the array is conceptually 1-dimensional then your code can treat it as such. The following sub modifies the sort of array that you get when you assign a range of values to a variant. It takes no action if it is genuinely 2 dimensional:

Sub FixArray(valArray As Variant) 'As Variant
'This sub takes a pseudo 2-dimenional 1-based variant array
'And makes it 1-dimensional

    Dim fixedArray As Variant
    Dim columnVector As Boolean
    Dim i As Long, m As Long, n As Long
    On Error GoTo err_handler

    m = UBound(valArray, 1)
    n = UBound(valArray, 2) 'will throw an error if already 1-dimensional
    If m > 1 And n > 1 Then Exit Sub 'can't be fixed without losing data
    If m > 1 Then
        columnVector = True
    Else
        columnVector = False
        m = n
    End If
    ReDim fixedArray(1 To m)
    For i = 1 To m
        If columnVector Then
            fixedArray(i) = valArray(i, 1)
        Else
            fixedArray(i) = valArray(1, i)
        End If
    Next i
    valArray = fixedArray
err_handler:
    'no action - nothing to fix
End Sub

A test sub (run in debug mode with the locals window open and see how v changes from 2 dimensional to 1 dimensional):

Sub test()
    Dim v As Variant
    v = Range("A1:A3").Value
    FixArray v
    Debug.Print "here" 'convenient breakpoint
End Sub