Copy multiple Ranges into Array without looping

Question

I want to copy data from separated ranges into an Array without looping.

The following approach only populates the array with data from rng1.

Dim rng1 As Range, rng2 As Range, rng3 As Range, rngMerge As Range
Dim tmpMatrixCPs_CDS() As Variant

Set WS_Ins_Mapping = ThisWorkbook.Worksheets("Instrumente_Mapping")
LastRow = WS_Ins_Mapping.Cells(rows.Count, 2).End(xlUp).Row
Set rng1 = WS_Ins_Mapping.Range(WS_Ins_Mapping.Cells(6, 2), WS_Ins_Mapping.Cells(LastRow, 2))
Set rng2 = WS_Ins_Mapping.Range(WS_Ins_Mapping.Cells(6, 26), WS_Ins_Mapping.Cells(LastRow, 26))
Set rng3 = WS_Ins_Mapping.Range(WS_Ins_Mapping.Cells(6, 36), WS_Ins_Mapping.Cells(LastRow, 36))
Set rngMerge = Union(rng1, rng2, rng3)
tmpMatrixCPs_CDS = WS_Ins_Mapping.Range(rngMerge).Value

Answer 1

Put all your columns in an array and then filter your columns out:

Sub Try()
Dim tmpMatrixCPs_CDS() As Variant, x As Variant
Set WS_Ins_Mapping = ThisWorkbook.Worksheets("Instrumente_Mapping")
lastrow = WS_Ins_Mapping.Cells(Rows.Count, 2).End(xlUp).Row

x = WS_Ins_Mapping.Range(WS_Ins_Mapping.Cells(6, 1), WS_Ins_Mapping.Cells(lastrow, 36))
tmpMatrixCPs_CDS = Application.Index(x, Application.Evaluate("row(1:" & lastrow - 5 & ")"), Array(2, 26, 36))
End Sub

Answer 2

If you are looking to transfer non-neighbouring columns to an array, then this is a possible option (with credit to Mr.Excel forum):

Sub TestMe()

    Dim rng1 As Range: Set rng1 = Range("A2:A10")
    Dim rng2 As Range: Set rng2 = Range("B2:B10")
    Dim rng3 As Range: Set rng3 = Range("C2:D10")
    Dim rngAll As Range: Set rngAll = Union(rng1, rng2, rng3)

    Dim myArr As Variant
    Dim firstRow As Long: firstRow = 1
    Dim lastRow As Long: lastRow = rngAll.Rows.Count

    Dim evalRows As Variant
    evalRows = Application.Evaluate("row(" & firstRow & ":" & lastRow & ")")

    myArr = Application.Index(rngAll, evalRows, Array(1, 3, 4))

    Dim myCol As Long, myRow As Long
    For myCol = LBound(myArr) To UBound(myArr)
        For myRow = LBound(myArr, 2) To UBound(myArr, 2)
            Debug.Print myArr(myCol, myRow)
        Next
    Next

End Sub

There are 2 tricky parts in the code above:

• The first row of a given range should be hardcoded to 1;
• Application.Index(rngAll, evalRows, Array(1, 3, 4)) The columns could be written manually or these can be taken as Rng1.Column;

---

If the ranges are without a gap, then this works:

Sub TestMe()

    Dim rng1 As Range: Set rng1 = Range("A1:A10")
    Dim rng2 As Range: Set rng2 = Range("B1:B10")
    Dim rng3 As Range: Set rng3 = Range("C1:D10")
    Dim rngAll As Range: Set rngAll = Union(rng1, rng2, rng3)

    Dim myArr As Variant
    myArr = Application.Transpose(rngAll)

    Dim myCol As Long, myRow As Long

    For myCol = LBound(myArr) To UBound(myArr)
        For myRow = LBound(myArr, 2) To UBound(myArr, 2)
            Debug.Print myArr(myCol, myRow)
        Next
    Next

End Sub