Sub Array_Dimensions()
Dim array1(10) As String
Dim array2(10, 10) As String
MsgBox NumberOfDimensions(array1)
MsgBox NumberOfDimensions(array2)
End Sub
'Code below based on http://support.microsoft.com/kb/152288
'There is no built-in function to return the number of dimensions in an array variable
'in Microsoft Visual Basic for Applications. The easiest way to do this is by looping through
'the dimensions and using an error handler to return the number of dimensions.
Private Function NumberOfDimensions(theArray As Variant) As Long
Dim DimNum As Long, ErrorCheck As Integer
'Sets up the error handler
On Error GoTo FinalDimension
'Visual Basic for Applications arrays can have up to 60000 dimensions; this allows for that
For DimNum = 1 To 60000
'It is necessary to do something with the LBound to force it to generate an error
ErrorCheck = LBound(theArray, DimNum)
Next
'The error routine
FinalDimension:
NumberOfDimensions = DimNum - 1
End Function
Function arrDim(arr As Variant) As Long
Dim a As Long, val As Long
On Error GoTo Err
Do
a = a + 1
val = UBound(arr, a)
Loop
Err:
arrDim = a - 1
End FunctionOption Explicit
#If VBA7 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
Private Enum VariantTypes
VTx_Empty = vbEmpty '(0) Uninitialized
'...
VTx_Array = vbArray '(8192)
VTx_ByRef = &H4000 '(16384) Is an indirect pointer to the Variant's data
End Enum
Type VariantStruct 'NOTE - the added "X_..." prefixes force the VBE Locals window to display the elements in
'their correct adjacency order:
A_VariantType As Integer '(2 bytes) See the VariantTypes Enum, above.
B_Reserved(1 To 6) As Byte '(6 bytes)
C_Data As LongLong '(8 bytes) NOTE: for an array-Variant, its Data is a pointer to the array.
End Type
Type ArrayStruct 'NOTE - the added "X_..." prefixes force the VBE Locals window to display the elements in
'their correct adjacency order:
A_DimCount As Integer '(aka cDim) 2 bytes: The number of dimensions in the array.
B_FeatureFlags As Integer '(aka fFeature) 2 bytes: See the FeatureFlags Enum, below.
C_ElementSize As Long '(aka cbElements) 4 bytes: The size of each element in the array.
D_LockCount As Long '(aka cLocks) 4 bytes: The count of active locks on the array.
E_DataPtr As Long '(aka pvData) 4 bytes: A pointer to the first data element in the array.
F_BoundsInfoArr As LongLong '(aka rgsabound) 8 bytes, min.: An info-array of SA_BoundInfo elements (see below)
' that contains bounds data for each dimension of the safe-array. There is one
' SA_BoundInfo element for each dimension in the array. F_BoundsInfoArr(0) holds
' the information for the right-most dimension and F_BoundsInfoArr[A_DimCount - 1]
' holds the information for the left-most dimension. Each SA_BoundInfo element is
' 8 bytes, structured as follows:
End Type
Function ArrayDims(SomeArray As Variant) As Long 'Cast the array argument to an array-Variant (if it isn't already)
'for a uniform reference-interface to it.
'
'Returns the number of dimensions of the specified array.
'
'AUTHOR: Peter Straton
'
'CREDIT: Adapted from wqw's post at:
' https://stackoverflow.com/questions/67016151/how-to-get-array-dimensionarray-parameter-pass-error
'
'*************************************************************************************************************
Dim DataPtrOffset As Integer
Dim DimCount As Integer '= ArrayStruct.A_DimCount (2 bytes)
Dim VariantType As Integer '= VariantStruct.A_VariantType (2 bytes)
Dim VariantDataPtr As LongLong '= VariantStruct.C_Data (8 bytes). See note about array-Variants' data, above.
'Check the Variant's type
Call CopyMemory(VariantType, SomeArray, LenB(VariantType))
If (VariantType And VTx_Array) Then
'It is an array-type Variant, so get its array data-pointer
Dim VariantX As VariantStruct 'Unfortunately, in VB/VBA, you can't reference the size of a user-defined
'data-Type element without instantiating one.
DataPtrOffset = LenB(VariantX) - LenB(VariantX.C_Data) 'Takes advantage of C_Data being the last element
Call CopyMemory(VariantDataPtr, ByVal VarPtr(SomeArray) + DataPtrOffset, LenB(VariantDataPtr))
If VariantDataPtr <> 0 Then
If (VariantType And VTx_ByRef) Then
'The passed array argument was not an array-Variant, so this function-call's cast to Variant type
'creates an indirect reference to the original array, via the Variant parameter. So de-reference
'that pointer.
Call CopyMemory(VariantDataPtr, ByVal VariantDataPtr, LenB(VariantDataPtr))
End If
If VariantDataPtr <> 0 Then
'Now have a legit Array reference, so get and return its dimension-count value
Call CopyMemory(DimCount, ByVal VariantDataPtr, LenB(DimCount))
End If
End If
End If
ArrayDims = DimCount
End Function 'ArrayDims
Sub Demo_ArrayDims()
'
'Demonstrates the functionality of the ArrayDims function using a 1-D, 2-D and 3-D array of various types
'
'*************************************************************************************************************
Dim Test2DArray As Variant
Dim Test3DArray() As Long
Debug.Print 'Blank line
Debug.Print ArrayDims(Array(20, 30, 400)) 'Test 1D array
Test2DArray = [{0, 0, 0, 0; "Apple", "Fig", "Orange", "Pear"}]
Debug.Print ArrayDims(Test2DArray)
ReDim Test3DArray(1 To 3, 0 To 1, 1 To 4)
Debug.Print ArrayDims(Test3DArray)
End SubPrivate Type SA_BoundInfo
ElementCount As Long '(aka cElements) 4 bytes: The number of elements in the dimension.
LBoundVal As Long '(aka lLbound) 4 bytes: The lower bound of the dimension.
End Type
Enum FeatureFlags
FADF_AUTO = &H1 'Array is allocated on the stack.
FADF_STATIC = &H2 'Array is statically allocated.
FADF_EMBEDDED = &H4 'Array is embedded in a structure.
FADF_FIXEDSIZE = &H10 'Array may not be resized or reallocated.
FADF_BSTR = &H100 'An array of BSTRs.
FADF_UNKNOWN = &H200 'An array of IUnknown pointers.
FADF_DISPATCH = &H400 'An array of IDispatch pointers.
FADF_VARIANT = &H800 'An array of VARIANT type elements.
FADF_RESERVED = &HF0E8 'Bits reserved for future use.
End Enum C_Data As LongLong '(8 bytes) NOTE: for an array-Variant, its Data is a pointer to the array. #If Win64 Then
C_Data As LongLong '(8 bytes) NOTE: for an array-Variant, its Data is a pointer to the array.
#Else
C_Data As Currency '(8 bytes) NOTE: for an array-Variant, its Data is a pointer to the array.
#End If F_BoundsInfoArr As LongLong '(aka rgsabound) 8 bytes, min.: An info-array of SA_BoundInfo elements (see below) #If Win64 Then
F_BoundsInfoArr As LongLong '(aka rgsabound) 8 bytes, min.
#Else
F_BoundsInfoArr As Currency '(aka rgsabound) 8 bytes, min.
#End If Dim VariantDataPtr As LongLong '= VariantStruct.C_Data (8 bytes). See note about array-Variants' data, above.#If VBA7 Then compiler directive to use the corrrect pointer size. LongPtr is a data type alias which is defined only in Office >= 2010 and it resolves to Long (32 bits) in 32-bit Office, or LongLong (64 bits) in 64-bit Office: #If VBA7 Then
Dim VariantDataPtr As LongPtr '= VariantStruct.C_Data (8 bytes). See note about array-Variants' data, above.
#Else
Dim VariantDataPtr As Long
#End If
MsgBox Ubound(varArray1)MsgBox Ubound(varArray1,2)It ran OK for me on Excel 2007, which has the same bit size as Excel 2003.
The code in this thread determines the number of dimensions in an array.
