Excel VBA Range To Array When Single Cell

wsnyder

Board Regular
Joined
Sep 23, 2018
Messages
131
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


VBA Code:
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
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Marcelo Branco

MrExcel MVP
Joined
Aug 23, 2010
Messages
16,907
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Maybe...

Code:
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.
 
Solution

Forum statistics

Threads
1,147,482
Messages
5,741,406
Members
423,657
Latest member
Medrok2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top