Populate 1-D Array from 2 sheets (without looping) - arrays

Question

Goal: populate 1-D array from 2 columns (in 2 different files) without looping.
The code where I'm trying to read the first list to an array fails on the line
MergeAccountOpportArr = NamesRng.Value
Attempted code:
Option Explicit
Public AccountsWB As Workbook
Public AccountsSht As Worksheet
' --- Columns Variables ---
Public Const NamesCol As String = "F"
' --- Public Arrays ---
Public MergeAccountOpportArr() As String
'===================================================================
Sub MergeRangestoArray()
Dim OpportWBName As String, AccountsWBName As String, WebinarWBName As String
Dim NamesRng As Rang
Dim LastRow As Long, i As Long
ReDim MergeAccountOpportArr(100000) 'init size array to very large size >> will optimize later
' open Accounts file
AccountsWBName = GetFileName(ThisWorkbook.Path, "Accounts")
' set the Accounts file workbook object
Set AccountsWB = Workbooks.Open(Filename:=AccountsWBName, ReadOnly:=True)
' set the worksheet object
Set AccountsSht = AccountsWB.Worksheets(1)
With AccountsSht
LastRow = FindLastRow(AccountsSht) ' get last row
Set NamesRng = .Range(.Cells(1, NamesCol), .Cells(LastRow, NamesCol))
MergeAccountOpportArr = NamesRng.Value ' <---- Here comes the error
End With
' rest of my code
End Sub

Answer 1

In theory, you should be able to do this by hacking around with the SAFEARRAY structures in memory. The indexing of the data area for a SAFEARRAY is determined by the product of the indexes of the individual dimensions, so if you have a two dimensional array where one dimension only has a single element, the memory addresses should be the same for a one dimensional array (row * 1 = row).
As proof of concept...
YOU CAN TRY THIS AT HOME KIDS, BUT THIS IS NOT PRODUCTION GRADE CODE.
'In declarations section:
#If VBA7 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, _
ByVal length As Long)
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, _
ByVal length As Long)
#End If
Private Const VT_BY_REF = &H4000&
Private Type SafeBound
cElements As Long
lLbound As Long
End Type
Private Type SafeArray
cDim As Integer
fFeature As Integer
cbElements As Long
cLocks As Long
#If VBA7 Then
pvData As LongPtr
#Else
pvData As Long
#End If
rgsabound As SafeBound
rgsabound2 As SafeBound
End Type
Public Function RangeToOneDimensionalArray(Target As Range) As Variant()
If Target.Columns.Count > 1 Or Target.Rows.Count = 1 Then
Err.Raise 5 'Invalid procedure call or argument
End If
Dim values() As Variant
values = Target.Value
If HackDimensions(values) Then
RangeToOneDimensionalArray = values
End If
End Function
Private Function HackDimensions(SafeArray As Variant) As Boolean
Dim vtype As Integer
'First 2 bytes are the VARENUM.
CopyMemory vtype, SafeArray, 2
Dim lp As Long
'Get the data pointer.
CopyMemory lp, ByVal VarPtr(SafeArray) + 8, 4
'Make sure the VARENUM is a pointer.
If (vtype And VT_BY_REF) <> 0 Then
'Dereference it for the actual data address.
CopyMemory lp, ByVal lp, 4
Dim victim As SafeArray
CopyMemory ByVal VarPtr(victim), ByVal lp, LenB(victim)
'Set the dimensions to 1
victim.cDim = 1
'Set the bound on the first dimension.
victim.rgsabound.cElements = victim.rgsabound2.cElements
CopyMemory ByVal lp, ByVal VarPtr(victim), LenB(victim)
HackDimensions = True
End If
End Function
Note that this has to swap the 2 dimensions (and the declarations are limited to 2D arrays). It also leaves the second dimension rgsabound "hanging", so you'll likely leak the memory for that structure (8 bytes) every time you run this.
The safer way would be to copy the contents of the memory area onto a new one dimensional array and use that instead, OR wrap this whole mess in a Class module and clean up after yourself when you get done.
Oh yeah, it works ;-)
Public Sub Testing()
Dim sample() As Variant
sample = RangeToOneDimensionalArray(Sheet1.Range("A1:A30"))
Dim idx As Long
For idx = 1 To 30
Debug.Print sample(idx)
Next
End Sub

Answer 2

This converts the ranges into a strings delimited by a specified character. It then joins the two lists into an array with split()
Note:
Delimiter will have to be a character not in your dataset
Transpose is due to your data being in columns. If your data is in rows you'll have to check it, maybe with something like a column count.
.
Sub Test()
Dim oResultArray() As String
oResultArray = MergeRngToArray(Sheet1.Range("B3:B12"), Sheet2.Range("B2:B6"))
End Sub
Private Function MergeRngToArray(ByVal Range1 As Range, ByVal Range2 As Range, Optional Delimiter As String = ",") As String()
Dim sRange1 As String
Dim sRange2 As String
sRange1 = Join(Application.WorksheetFunction.Transpose(Range1.Value), Delimiter) & Delimiter
sRange2 = Join(Application.WorksheetFunction.Transpose(Range2.Value), Delimiter)
MergeRngToArray = Split(sRange1 & sRange2, Delimiter)
End Function

Answer 3

Start with the easier problem of copying cells into a 1D array
You can go from a 1D array to a range easily with the following trick:
Public Sub TESTING()
Dim keyarr() As Variant
keyarr = Array("1", "2", "3", "4", "5")
Range("D3").Resize(5, 1).Value = WorksheetFunction.Transpose(keyarr)
End Sub
But the opposite is much harder because the .Value property of a range always returns a 2D array.
Except when used with the transpose function:
Public Sub TESTING()
Dim i As Long, n As Long
Dim keyarr() As Variant
n = Range(Range("B3"), Range("B3").End(xlDown)).Rows.Count
keyarr = WorksheetFunction.Transpose(Range("B3").Resize(n, 1).Value)
' keyarr is a n×1 1D array
' Proof:
For i = 1 To n
Debug.Print keyarr(i)
Next i
End Sub
The trick is a) use the .Transpose() function to make a column into a single row and b) to use an array of Variant and not String. Internally the array will store strings, but the type has to be Variant.
Now the last problem is to combine two arrays
The only solution I can think of is to combine the data into a different worksheet.
Public Sub TESTING()
Dim i As Long, n1 As Long, n2 As Long
Dim vals1() As Variant, vals2() As Variant
' Pull two sets of data from two columns. You could use different sheets if you wanted.
n1 = Range(Range("B3"), Range("B3").End(xlDown)).Rows.Count
vals1 = WorksheetFunction.Transpose(Range("B3").Resize(n1, 1).Value)
n2 = Range(Range("D3"), Range("D3").End(xlDown)).Rows.Count
vals2 = WorksheetFunction.Transpose(Range("D3").Resize(n2, 1).Value)
Sheet2.Range("A1").Resize(n1, 1).Value = WorksheetFunction.Transpose(vals1)
Sheet2.Range("A1").Offset(n1, 0).Resize(n2, 1).Value = WorksheetFunction.Transpose(vals2)
Dim keyarr() As Variant
keyarr = WorksheetFunction.Transpose(Sheet2.Range("A1").Resize(n1 + n2, 1).Value)
End Sub

Answer 4

Array approach
Sub JoinColumnArrays(a, b)
'Purpose: join 2 vertical 1-based 2-dim datafield arrays based on two range columns
'Note: returns 2-dim array with only 1 column
'Hint: overcomes ReDim Preserve restriction to change only the last dimension!
a = Application.Index(a, Evaluate("row(1:" & UBound(a) + UBound(b) & ")"), 0)
Dim i As Long, Start As Long: Start = UBound(a) - UBound(b)
For i = 1 To UBound(b)
a(Start + i, 1) = b(i, 1) ' fills empty a elements with b elements
Next i
End Sub
The above array approach returns a 1-based 2-dim array (of only 1 "column" as 2nd dimension) with changed UBound(a) value, i.e. the sum of the original "row" count of array a plus elements count of array b.
Note that using the Application.Index() function overcomes the restriction of ReDim Preserve which only would change an array's last dimension.
Example Call
'...
Dim a as Variant, b as Variant
dim ws1 as Worksheet, ws2 as Worksheet
' Set ws1 = ... ' << change worksheet definitions to your needs
' Set ws2 = ...
a = ws1.Range("A2:B4") ' assign column data from different sheets
b = ws2.Range("C2:C3")
JoinColumnArrays a, b ' << call procedure JoinColumnArrays
'Debug.Print "column ~>" & Join(Application.Transpose(Application.Index(a, 0, 1)), ", ")