Get values from union of non-contiguous ranges into array with VBA with a simple command (no loops)

Question

I have the following (on the surface of it, simple) task:

Copy the values from a number of columns on a spreadsheet into a 2D array using VBA.

To make life more interesting, the columns are not adjacent, but they are all of the same length. Obviously one could do this by looping over every element in turn, but that seems very inelegant. I am hoping there is a more compact solution - but I struggle to find it.

Here are some attempts of what I would consider "a simple approach" - for simplicity, I am putting the range as A1:A5, D1:D5 - a total of 10 cells in two ranges.

Private Sub testIt()
  Dim r1, r2, ra, rd, rad
  Dim valString, valUnion, valBlock
  Set r1 = Range("A1:A5")
  Set r2 = Range("D1:D5")
  valString = Range("A1:A5,D1:D5").Value
  valUnion = Union(r1, r2).Value
  valBlock = Range("A1:D5").Value
End Sub

When I look at each of these variables, the first two have dimension (1 To 5, 1 To 1) while the last one has (1 To 5, 1 To 4). I was expecting to get (1 To 5, 1 To 2) for the first two, but that was not the case.

I would be happy if I could loop over the data one column at the time, and assign all the values in one column to one column in the array - but I could not figure out how to do that either. Something like

cNames = Array("A", "D")
ci = 1
For Each c in columnNames
  vals( , ci) = Range(c & "1:" & c & "5").Value
  ci = ci + 1
Next c  

But that's not the right syntax. The result I want to get would be achieved with

cNames = Array("A", "D")
ci = 1
For Each c in columnNames
  For ri = 1 To 5
    vals(ri , ci) = Range(c & "1").offset(ri-1,0).Value
  Next ri
  ci = ci + 1
Next c  

But that's pretty ugly. So here is my question:

Is it possible to get the values of a "composite range" (multiple non-contiguous blocks) into an array - either all at once, or a columns at a time? If so, how do I do it?

For extra bonus points - can anyone explain why the arrays returned in testIt() are dimensioned Base 1, whereas my VBA is set to Option Base 0? In other words - why are they not (0 To 4, 0 To 0)? Is this just one more inconsistency on the part of Microsoft?

Answer 1

Provided each area in rng has the same number of rows then this should work.

Function ToArray(rng) As Variant()
    Dim arr() As Variant, r As Long, nr As Long
    Dim ar As Range, c As Range, cnum As Long, rnum As Long
    Dim col As Range

    nr = rng.Areas(1).Rows.Count
    ReDim arr(1 To nr, 1 To rng.Cells.Count / nr)
    cnum = 0
    For Each ar In rng.Areas
        For Each col In ar.Columns
        cnum = cnum + 1
        rnum = 1
        For Each c In col.Cells
            arr(rnum, cnum) = c.Value
            rnum = rnum + 1 'EDIT: added missing line...
        Next c
        Next col
    Next ar

    ToArray = arr
End Function

Usage:

Dim arr
arr = ToArray(Activesheet.Range("A1:A5,D1:D5"))
Debug.Print UBound(arr,1), UBound(arr,2)

As for why array from rng.Value are 1-based instead of zero-based, I'd guess it's because that maps more readily to actual row/column numbers on the worksheet than if it were zero-based. The Option Base x setting is ignored

Answer 2

It is possible to accomplish what you want if you're willing to add a hidden worksheet. I used Excel 2010 and created two worksheets (Sheet1 / Sheet2) to test my findings. Below is the code:

Private Sub TestIt()

    ' Src = source
    ' Dst = destination
    ' WS  = worksheet

    Dim Data    As Variant
    Dim SrcWS   As Excel.Worksheet
    Dim DstWS   As Excel.Worksheet

    ' Get a reference to the worksheet containing the
    ' source data
    Set SrcWS = ThisWorkbook.Worksheets("Sheet1")

    ' Get a reference to a hidden worksheet.
    Set DstWS = ThisWorkbook.Worksheets("Sheet2")

    ' Delete any data found on the hidden worksheet
    DstWS.UsedRange.Columns.EntireColumn.Delete

    ' Copy the non-contiguous range into the hidden
    ' worksheet.
    SrcWS.Range("A1:A5,D1:D5").Copy DstWS.Range("A1")

    ' Now all of the data can be stored in a variable
    ' as a 2D array because it will be contiguous on
    ' the hidden worksheet.
    Data = DstWS.UsedRange.Value

End Sub