Create an empty 2d array
This is only going to work for Windows (not for Mac):
Option Explicit
#If Mac Then
#Else
#If VBA7 Then
Private Declare PtrSafe Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As LongPtr
Private Declare PtrSafe Function VariantCopy Lib "OleAut32.dll" (pvargDest As Any, pvargSrc As Any) As Long
Private Declare PtrSafe Function SafeArrayDestroy Lib "OleAut32.dll" (ByVal psa As LongPtr) As Long
#Else
Private Declare Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As Long
Private Declare Function VariantCopy Lib "OleAut32.dll" (pvargDest As Variant, pvargSrc As Any) As Long
Private Declare Function SafeArrayDestroy Lib "OleAut32.dll" (ByVal psa As Long) As Long
#End If
#End If
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type tagVariant
vt As Integer
wReserved1 As Integer
wReserved2 As Integer
wReserved3 As Integer
#If VBA7 Then
ptr As LongPtr
#Else
ptr As Long
#End If
End Type
Public Function EmptyArray(ByVal numberOfDimensions As Long, ByVal vType As VbVarType) As Variant
'In Visual Basic, you can declare arrays with up to 60 dimensions
Const MAX_DIMENSION As Long = 60
If numberOfDimensions < 1 Or numberOfDimensions > MAX_DIMENSION Then
Err.Raise 5, "EmptyArray", "Invalid number of dimensions"
End If
#If Mac Then
Err.Raise 298, "EmptyArray", "OleAut32.dll required"
#Else
Dim bounds() As SAFEARRAYBOUND
#If VBA7 Then
Dim ptrArray As LongPtr
#Else
Dim ptrArray As Long
#End If
Dim tVariant As tagVariant
Dim i As Long
'
ReDim bounds(0 To numberOfDimensions - 1)
'
'Make lower dimensions [0 to 0] instead of [0 to -1]
For i = 1 To numberOfDimensions - 1
bounds(i).cElements = 1
Next i
'
'Create empty array and store pointer
ptrArray = SafeArrayCreate(vType, numberOfDimensions, bounds(0))
'
'Create a Variant pointing to the array
tVariant.vt = vbArray + vType
tVariant.ptr = ptrArray
'
'Copy result
VariantCopy EmptyArray, tVariant
'
'Clean-up
SafeArrayDestroy ptrArray
#End If
End Function
You can now create empty arrays with different number of dimensions and data types:
Sub Test()
Dim arr2D() As Variant
Dim arr4D() As Double
'
arr2D = EmptyArray(2, vbVariant)
arr4D = EmptyArray(4, vbDouble)
Stop
End Sub