How to get range of cells into a specific array dimension

Viewed 337

I need to get a range of cells into an array, which by itself is simple enough:

Dim matchArray As Variant
matchArray = Sheets(lookupSheet).Range("B2:B12000").Value2

This creates a two-dimensional array with one column as the second dimension and if you expand the range to include a second column it creates a two-dimensional array with two columns for the second dimension:

matchArray = Sheets(lookupSheet).Range("B2:C12000").Value2

But what if the two columns aren't next to each other and you don't want the one in the middle?

matchArray = Sheets(lookupSheet).Range("B2:B12000,D2:D12000").Value2

The above would be my best guess but it doesn't work, it only returns the first range specified.

So what I need is a way to return a range cell values into a specific dimension of the array.

I know I could do it by looping through the rows but that would take far too long with the number of rows I'm going to be working with.

4 Answers

You do need a loop -- but loop over VBA arrays rather than individual cells:

Sub Test()
    Dim A As Variant, B As Variant, C As Variant
    Dim i As Long
    B = Sheets(lookupSheet).Range("B2:B12000").Value2
    C = Sheets(lookupSheet).Range("D2:D12000").Value2
    ReDim A(1 To 11999, 1 To 2)
    For i = 1 To 11999
        A(i, 1) = B(i, 1)
        A(i, 2) = C(i, 2)
    Next i
    'do stuff with A
End Sub

This should only take a fraction of a second.

You can do it with a ragged array:

Dim var1(1 To 2) As Variant
Dim var As Variant
var = Range("A1:A10").Value2
var1(1) = var
var = Range("c1:c10").Value2
var1(2) = var
MsgBox var1(1)(3, 1)

Here are a couple more ways:

Sub Example1()
    Const lookupSheet As String = "Sheet1"
    Dim matchArray As Variant, arr1 As Variant, arr2 As Variant

    With Sheets(lookupSheet)
        arr1 = WorksheetFunction.Transpose(.Range("B2:B12000").Value2)
        arr2 = WorksheetFunction.Transpose(.Range("D2:D12000").Value2)
        matchArray = WorksheetFunction.Transpose(Array(arr1, arr2))
    End With
End Sub

Sub Example2()
    Const lookupSheet As String = "Sheet1"
    Dim matchArray As Variant
    Dim x As Long

    With Sheets(lookupSheet)
        matchArray = .Range("B2:B12000").Resize(, 2).Value2
        For Each v In .Range("D2:D12000").Value2
            x = x + 1
            matchArray(x, 2) = v
        Next
    End With
End Sub

Probably no quicker than John Coleman's answer, but I think this does what you want.

Sub x()

Dim matchArray, r As Range

Set r = Sheets(lookupSheet).Range("B2:D12000")

matchArray = Application.Index(r, Evaluate("Row(1:" & r.Rows.Count & ")"), Array(1, 3))

End Sub
Related