Get values from union of non-contiguous ranges into array with VBA with a simple command (no loops)
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?
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
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