Excel VBA Range To Array When Single Cell

[wsnyder]

Hi all,

Using Excel 365.

I need to transfer a Range based on user inputs to an Array to be used as Filter Criteria. My challenge is that the user may select from 1 to n items from a list.
I had code working for multiple items in the Range, but it wasn't working for a Range that was a single cell.

Now the code is working for a single cell Range, but not working if there are 2 or more rows in the Range.
What is the best way to handle the Dynamic Range when transferring to an Array?

Thanks,
-w

Error:
Run-time error '9':
Subscript out of range

Sub RangeToArray()

    'Objects
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim rng As Range
        
    'Arrays
        Dim arr As Variant
    
    'Variables
        Dim i As Long
        
    'Initialize
        Set wb = ThisWorkbook
        Set ws = wb.Worksheets(1)
        Set rng = ws.Range("A1:A2")
    
    'Populate the array from the range
        arr = rng.Value
        If Not IsArray(arr) Then arr = Array(arr)
        
    'Test the array
        For i = LBound(arr) To UBound(arr)
            Debug.Print i, arr(i)
        Next i
        
    'Tidy up
        Erase arr
        Set rng = Nothing
        Set ws = Nothing
        Set wb = Nothing
End Sub

 

[Marcelo Branco]

Maybe...

Sub RangeToArray()

    'Objects
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim rng As Range
        
    'Arrays
        Dim arr As Variant
    
    'Variables
        Dim i As Long
        
    'Initialize
        Set wb = ThisWorkbook
        Set ws = wb.Worksheets(1)
        Set rng = ws.Range("A1:A1")
    
    'Populate the array from the range
        If rng.Cells.Count = 1 Then
            ReDim arr(1 To 1, 1 To 1)
            arr(1, 1) = rng.Value
        Else
            arr = rng.Value
        End If
    
        
    'Test the array
        For i = LBound(arr) To UBound(arr)
            Debug.Print i, arr(i, 1)
        Next i
        
    'Tidy up
        Erase arr
        Set rng = Nothing
        Set ws = Nothing
        Set wb = Nothing
End Sub

Hope this helps

M.

 

[wsnyder]

Thanks Marcelo,

Works great!
-w

 

[Marcelo Branco]

You're welcome. Glad to help.

M.