Creating variant array from union of ranges - excel

Question

I want to create a variant array when using a union to join ranges.
If I select one of the ranges the variant array will work.
When I union, I only receive the row dimensions and not the column dimensions.
For example,
Sub arrTest()
'Declare varbs
Dim ws As Worksheet
Dim myArr() As Variant
Dim lRow As Integer
Dim myRng As Range
'Assign varbs
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
lRow = .Cells(Rows.count, "C").End(xlUp).row
Set myRng = Application.Union(.Range("G3:G" & lRow), .Range("J3:O" & lRow), .Range("AD3:AE" & lRow), .Range("AI3:AI" & lRow))
myArr = myRng.Value2
End With
Will return a variant of
myArr(1, 1)
myArr(2, 1)
myArr(1, 3)
However if I were to select one of the ranges within the union for example:
Sub arrTest()
'Declare varbs
Dim ws As Worksheet
Dim myArr() As Variant
Dim lRow As Integer
Dim myRng As Range
'Assign varbs
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
lRow = .Cells(Rows.count, "C").End(xlUp).row
Set myRng = .Range("J3:O" & lRow)
myArr = myRng.Value2
End With
I properly get
myArr(1, 1)
myArr(1, 2)
myArr(1, 3)
etc.
How do I return the column dimensions as well, without looping through the sheet?

Answer 1

Like this:
Sub ArrayTest()
Dim ws As Worksheet
Dim arr, lrow As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
lrow = ws.Cells(Rows.Count, "C").End(xlUp).Row
arr = GetArray(ws.Range("G3:G" & lrow), ws.Range("J3:O" & lrow), _
ws.Range("AD3:AE" & lrow), ws.Range("AI3:AI" & lrow))
With ThisWorkbook.Worksheets("Sheet2").Range("B2")
.Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End With
End Sub
'Given a number of input ranges each consisting of one or more columns (assumed all input ranges have
' the same # of rows), return a single 1-based 2D array with the data from each range
Function GetArray(ParamArray sourceCols() As Variant) As Variant
Dim arr, rng, numCols As Long, numRows As Long, r As Long, c As Long, tmp, col As Long
numRows = sourceCols(0).Rows.Count
'loop over ranges and get the total number of columns
For Each rng In sourceCols
numCols = numCols + rng.Columns.Count
Next rng
ReDim arr(1 To numRows, 1 To numCols) 'size the output array
c = 0
For Each rng In sourceCols 'loop the input ranges
tmp = As2DArray(rng) 'get range source data as array ####
For col = 1 To UBound(tmp, 2) 'each column in `rng`
c = c + 1 'increment column position in `arr`
For r = 1 To numRows 'fill the output column
arr(r, c) = tmp(r, col)
Next r
Next col
Next rng
GetArray = arr
End Function
'Get a range's value, always as a 2D array, even if only a single cell
Function As2DArray(rng)
If rng.Cells.Count > 1 Then
As2DArray = rng.Value
Else
Dim arr(1 To 1, 1 To 1)
arr(1, 1) = rng.Value
As2DArray = arr
End If
End Function