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

that behavior seems strange, but perhaps the array doesn't accept non-contiguous ranges (or only sees the first area as valid). Copy the values of each range into a contiguous range, then set then load that into the array. — Scott Holtzman
– Scott Holtzman, Commented Jun 25, 2018 at 15:24
Either copy paste into contiguous ranges, or load three arrays and make an array of arrays. But to get a 2 dimensional array the quickest is to load three arrays, then loop those loading a fourth. — Scott Craner
– Scott Craner, Commented Jun 25, 2018 at 15:42

EvR · Accepted Answer · 2018-06-25 15:53:49Z

7

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

answered Jun 25, 2018 at 15:53

EvR

3,5082 gold badges17 silver badges25 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

Scott Craner Over a year ago

Impressive use of evaluate to return an array.

Vityata · Accepted Answer · 2018-06-25 16:30:49Z

1

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

edited Jun 25, 2018 at 16:30

answered Jun 25, 2018 at 15:46

Vityata

43.8k10 gold badges64 silver badges110 bronze badges

1 Comment

Philipp_PK Over a year ago

Unfortunately, this Approach doesn't work properly. If I check 'myArr' the first column is popluated with the correct values but the second and third column isn't. They are filled with "Errors". Am I missing something?

Bruno Campanini · Accepted Answer · 2020-11-13 22:20:04Z

0

Public Sub ArrWork()
Dim R As Range, h, i, j
Dim MyArr(1 To 3, 1 To 9) As Integer, M()
M = Array(1, 2, 4)
Set R = Range("A1:A9")
For Each i In R
    h = h + 1
    For j = 1 To 3
        MyArr(j, h) = i(1, M(j - 1))
        MsgBox MyArr(j, h)
    Next
Next
End Sub

answered Nov 13, 2020 at 22:20

Bruno Campanini

1

1 Comment

Mark Rotteveel Over a year ago

Please don't post only code as answer, but also provide an explanation what your code does and how it solves the problem of the question. Answers with an explanation are usually more helpful and of better quality, and are more likely to attract upvotes.

Collectives™ on Stack Overflow

Copy multiple Ranges into Array without looping

3 Answers 3

1 Comment

1 Comment

1 Comment

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

1 Comment

1 Comment

1 Comment

Your Answer

Sign up or log in

Post as a guest

Linked

Related