arraysexcelvbarangevariant

How do I assign a range and a 1d array to a 2d variant array?

I'm working on a particular problem wherein I have to read multiple columns from a "sheet" in "file". These columns are to be temporarily stored in a "fileArray" and after some operations, transferred to a "masterFile".

Basically, the range has around 40k values for each column which I want to assign to fileArray(1 to 4)

I'm getting a Subscript out of range error whenever I try to assign values to the fileArray.

                ReDim fileArray(1 To 4, 1 To fileLastRow - 1)
                Dim arr As Variant
                ' Copy all relevant columns from sheet
                arr = Flatten(sheet.Range(sheet.Cells(2, fileKeyColumn), sheet.Cells(fileLastRow, fileKeyColumn)))
                
                fileArray(1) = arr ' Keep getting subscript out range errors here
                AssignVal fileArray, 1, sheet.Range(sheet.Cells(2, fileKeyColumn), sheet.Cells(fileLastRow, fileKeyColumn))
                If fileTF1Column <> 0 Then fileArray(2) = Flatten(sheet.Range(Cells(2, fileTF1Column), Cells(fileLastRow, fileTF1Column)).value)
                If fileTF2Column <> 0 Then fileArray(3) = Flatten(sheet.Range(Cells(2, fileTF2Column), Cells(fileLastRow, fileTF2Column)).value)
                If fileTF3Column <> 0 Then fileArray(4) = Flatten(sheet.Range(Cells(2, fileTF3Column), Cells(fileLastRow, fileTF3Column)).value)

I tried assigning the value directly as fileArray(1) = sheet.Range(sheet.Cells(2, fileKeyColumn), sheet.Cells(fileLastRow, fileKeyColumn))

and

fileArray(1) = sheet.Range(sheet.Cells(2, fileKeyColumn), sheet.Cells(fileLastRow, fileKeyColumn)).value

I also tried using Set statement.

When that didn't work, I adapted a Flatten function from a post I found on Stack Overflow to convert range into a 1-d array. I tried assigning it directly to "fileArray(1)" and via a temporary variable "arr".

I even tried creating an AssignVal subroutine to loop through the range and assign value to the Array.

So far, nothing seems to work and my deadline is fast approaching. I'm unable to understand what I'm doing wrong. Can someone help me with this? Also please explain the logic so I can figure it out for myself next time. Thanks!

Public Function Flatten(inputRange As Range) As Variant()
    'Adapted from code found at https://stackoverflow.com/questions/37689847/creating-an-array-from-a-range-in-vba
    
    Dim out() As Variant
    ReDim out(1 To inputRange.Rows.count)

    Dim i As Long
    For i = 1 To inputRange.Rows.count
        out(i) = inputRange(i, 1) 'loop over a range "row"
    Next

    Flatten = out
End Function

Public Sub AssignVal(ByRef inputVar() As Variant, ByVal index As Integer, ByVal inputRange As Range)
    'Adapted from code found at https://stackoverflow.com/questions/37689847/creating-an-array-from-a-range-in-vba
    
    Dim i As Long
    
    If UBound(inputVar, 2) = inputRange.Rows.count Then
    
    For i = 1 To inputRange.Rows.count
        Set inputVar(index)(i) = inputRange(i, 1).value 'loop over a range "row"
    Next
    
    End If

End Sub

EDIT:

I found out that I was referencing the array like a dictionary in AssignVal which was causing the problem. The fixed code is here in case someone else has a similar problem. I'm keeping this question open in hopes of finding a more elegant answer.

                ReDim fileArray(1 To 4, 1 To fileLastRow - 1)
                
                ' Copy all relevant columns from sheet
                
                With sheet
                    AssignVal fileArray, 1, Flatten(.Range(.Cells(2, fileKeyColumn), .Cells(fileLastRow, fileKeyColumn)))
                    If fileTF1Column <> 0 Then AssignVal fileArray, 2, Flatten(.Range(.Cells(2, fileTF1Column), .Cells(fileLastRow, fileTF1Column)))
                    If fileTF2Column <> 0 Then AssignVal fileArray, 3, Flatten(.Range(.Cells(2, fileTF2Column), .Cells(fileLastRow, fileTF2Column)))
                    If fileTF3Column <> 0 Then AssignVal fileArray, 4, Flatten(.Range(.Cells(2, fileTF3Column), .Cells(fileLastRow, fileTF3Column)))
                End With

The final procedures used:

Public Function Flatten(inputRange As Range) As Variant()
    'Adapted from code found at https://stackoverflow.com/questions/37689847/creating-an-array-from-a-range-in-vba
    
    Dim out() As Variant
    ReDim out(1 To inputRange.Rows.count)

    Dim i As Long
    For i = 1 To inputRange.Rows.count
        out(i) = inputRange(i, 1) 'loop over a range "row"
    Next

    Flatten = out
End Function

Public Sub AssignVal(ByRef inputVar() As Variant, ByVal index As Integer, ByRef inputVarArr() As Variant)
    'Adapted from code found at https://stackoverflow.com/questions/37689847/creating-an-array-from-a-range-in-vba
    
    Dim i As Long
    
    If UBound(inputVar, 2) = UBound(inputVarArr) Then
    
    For i = 1 To UBound(inputVar, 2)
         inputVar(index, i) = inputVarArr(i) 'loop over a range "row"
    Next
    
    End If

End Sub
Solution

  • In your solution the function Flatten is unnecessary. You need only to redefine AssignVal a bit.

    Public Sub AssignVal(ByRef inputVar() As Variant, ByVal index As Integer, ByVal inputRange As Range)
    'Adapted from code found at https://stackoverflow.com/questions/37689847/creating-an-array-from-a-range-in-vba
    Dim i As Long
    If UBound(inputVar, 2) = inputRange.Rows.Count Then
        For i = 1 To inputRange.Rows.Count
            inputVar(index, i) = inputRange(i, 1).Value 'loop over a range "row"
        Next i
    End If
End Sub

    But still you can avoid even this one loop if you accept 2-level structure of your array. Here is an example.

    Sub TestArray()
   Dim fileArray()
   ReDim fileArray(1 To 2)
   Dim sheet As Worksheet
   Set sheet = ActiveSheet
   Const fileKeyColumn1 = 5
   Const fileKeyColumn2 = 8
   Const fileLastRow = 10
   fileArray(1) = sheet.Range(sheet.Cells(2, fileKeyColumn1), sheet.Cells(fileLastRow, fileKeyColumn1)).Value
   fileArray(2) = sheet.Range(sheet.Cells(2, fileKeyColumn2), sheet.Cells(fileLastRow, fileKeyColumn2)).Value
   Debug.Print fileArray(1)(3, 1)
   Debug.Print fileArray(2)(5, 1)
End Sub

    Two_columns