The approach in section A) Double zero-indexing is meant as a reply to your own answer with the intention to demonstrate another relatively unknown variation of Application.WorksheetFunction.Index()
and focussing upon your initial Union
range.
If you dispose, however of the newer dynamic array features of MS 365, you can find a fast, flexible and straight-forward approach in section B) Flexible Worksheet related evaluation (late post as of 2021-11-18).
A) Double zero-indexing
You posted a solution creating a great datafield array including a lot of unneeded columns in between which you remove via Application.Index()
keeping only the column numbers in Array(1,3,8)
. You might be interested in this overview of some pecularities of Application.Index()
I wrote over 3 years ago.
Instead of removing all unneeded columns from a datafield array, you could do the reverse starting from the posted Union range:
- collect only the existing area data (single columns of identical lengths assumed) in a so called jagged array (aka array of arrays or array container) and
- unite all to a coherent 2-dim array via
Application.Index(data, 0, 0)
- note the double zero arguments here!
Option Explicit
Sub CopyData()
'Site: https://stackoverflow.com/questions/69951489/how-can-i-add-different-ranges-to-an-array
'Note: needs identical number of elements in each area of one column!
'[0]build example Union range as in original post
With Sheet1 ' change as needed
Dim lastR As Long
lastR = .Cells(.Rows.Count, 1).End(xlUp).Row
Dim u As Range
Set u = Union(.Range("A8:A" & lastR), _
.Range("C8:C" & lastR), _
.Range("H8:H" & lastR))
End With
'[1]assign "flat" (transposed) column data to a jagged array (array container)
Dim data
With Application.WorksheetFunction ' preferrable inst/of Application only
data = Array(.Transpose(u.Areas(1)), .Transpose(u.Areas(2)), Application.Transpose(u.Areas(3)))
End With
'[2]unite data as 2-dim array
data = Application.Transpose(Application.Index(data, 0, 0))
'[3]write to any target (e.g. Sheet2)
Sheet2.Range("A1").Resize(UBound(data, 1), UBound(data, 2)) = data
End Sub
Caveat
Note that since vers. 2016 transposing with Application.WorksheetFunction.Transpose
overcomes the limit of 65536 (2 ^ 16) if applied to ranges; unfortunably it rests unchanged if applied upon arrays.
B) Flexible worksheet-related evaluation // (added 2021-11-18)
Fast approach based on version MS 365
As in section A) I assume non-adjacent single columns. The main logic lies in the built formula string capable to get a 2-dim array in the order defined by your initial Union
range. In your example the number of areas (expressed as array) and the area addresses might result in something like
=LET(data,CHOOSE({1,2,3},A8:A20,C8:C20,H8:H20),data)
where CHOOSE
via {1,2,3}
reflects the wanted order of the listed columns after another evaluation applying ARRAYTOTEXT
upon a SEQUENCE
.
Sub CopyDataNew()
Dim t As Double: t = Timer
'[0]build example Union range as in original post
With Sheet1 ' change as needed
Dim lastR As Long
lastR = .Cells(.Rows.Count, 1).End(xlUp).Row
Dim u As Range
Set u = Union(.Range("A8:A" & lastR), _
.Range("C8:C" & lastR), _
.Range("H8:H" & lastR))
'[1]a) get sequence string, e.g. "{1,2,3}" (note "."-prefix of .Evaluate!)
Dim arrText As String
arrText = .Evaluate("ARRAYTOTEXT(SEQUENCE(1," & u.Areas.Count & ",1),1)")
'[1]b) get formula string,
Dim myFormula As String
myFormula = "=LET(data,CHOOSE(" & arrText & "," & u.Address(False, False) & "),data)"
Debug.Print myFormula
'[1]c) execute worksheet related evaluation (fully qualifying union addresses)
Dim data
data = .Evaluate(myFormula)
'[2]write to any target range
With Sheet2
.Range("A2").Resize(UBound(data, 1), UBound(data, 2)) = data
'' or enter formula into sheet to display as spill range
' .Range("A2").Formula2 = myFormula
End With
Debug.Print Format(Timer - t, "0.00 secs needed!")
End Sub
Hint A worksheet related evaluation - e.g. Sheet1.Evaluate(myFormula)
- has the advantage that any internal range references are automatically fully qualified.