How to return the number of dimensions of a (Variant) variable passed to it in VBA [duplicate]

Does anyone know how to return the number of dimensions of a (Variant) variable passed to it in VBA?

Function getDimension(var As Variant) As Long
    On Error GoTo Err
    Dim i As Long
    Dim tmp As Long
    i = 0
    Do While True
        i = i + 1
        tmp = UBound(var, i)
    Loop
Err:
    getDimension = i - 1
End Function

That's the only way I could come up with. Not pretty….

Looking at MSDN, they basically did the same.

To return the number of dimensions without swallowing errors:

#If VBA7 Then
  Private Type Pointer: Value As LongPtr: End Type
  Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (ByRef dest As Any, ByRef src As Any, ByVal Size As LongPtr)
#Else
  Private Type Pointer: Value As Long: End Type
  Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (ByRef dest As Any, ByRef src As Any, ByVal Size As Long)
#End If

Private Type TtagVARIANT
    vt As Integer
    r1 As Integer
    r2 As Integer
    r3 As Integer
    sa As Pointer
End Type


Public Function GetDims(source As Variant) As Integer
    Dim va As TtagVARIANT
    RtlMoveMemory va, source, LenB(va)                                            ' read tagVARIANT              '
    If va.vt And &H2000 Then Else Exit Function                                   ' exit if not an array         '
    If va.vt And &H4000 Then RtlMoveMemory va.sa, ByVal va.sa.Value, LenB(va.sa)  ' read by reference            '
    If va.sa.Value Then RtlMoveMemory GetDims, ByVal va.sa.Value, 2               ' read cDims from tagSAFEARRAY '
End Function

Usage:

Sub Examples()

    Dim list1
    Debug.Print GetDims(list1)    ' >> 0  '

    list1 = Array(1, 2, 3, 4)
    Debug.Print GetDims(list1)    ' >> 1  '

    Dim list2()
    Debug.Print GetDims(list2)    ' >> 0  '

    ReDim list2(2)
    Debug.Print GetDims(list2)    ' >> 1  '

    ReDim list2(2, 2)
    Debug.Print GetDims(list2)    ' >> 2  '

    Dim list3(0 To 0, 0 To 0, 0 To 0)
    Debug.Print GetDims(list3)    ' >> 3  '

End Sub

@cularis and @Issun have perfectly adequate answers for the exact question asked. I'm going to question your question, though. Do you really have a bunch of arrays of unknown dimension count floating around? If you're working in Excel, the only situation where this should occur is a UDF where you might get passed either a 1-D array or a 2-D array (or a non-array), but nothing else.

You should almost never have a routine that expects something arbitrary though. And thus you probably shouldn't have a general "find # of array dimensions" routine either.

So, with that in mind, here is the routines I use:

Global Const ERR_VBA_NONE& = 0
Global Const ERR_VBA_SUBSCRIPT_OUT_OF_RANGE& = 9

'Tests an array to see if it extends to a given dimension
Public Function arrHasDim(arr, dimNum As Long) As Boolean
    Debug.Assert IsArray(arr)
    Debug.Assert dimNum > 0

    'Note that it is possible for a VBA array to have no dimensions (i.e.
    ''LBound' raises an error even on the first dimension). This happens
    'with "unallocated" (borrowing Chip Pearson's terminology; see
    'http://www.cpearson.com/excel/VBAArrays.htm) dynamic arrays -
    'essentially arrays that have been declared with 'Dim arr()' but never
    'sized with 'ReDim', or arrays that have been deallocated with 'Erase'.

    On Error Resume Next
        Dim lb As Long
        lb = LBound(arr, dimNum)

        'No error (0) - array has given dimension
        'Subscript out of range (9) - array doesn't have given dimension
        arrHasDim = (Err.Number = ERR_VBA_NONE)

        Debug.Assert (Err.Number = ERR_VBA_NONE Or Err.Number = ERR_VBA_SUBSCRIPT_OUT_OF_RANGE)
    On Error GoTo 0
End Function

'"vect" = array of one and only one dimension
Public Function isVect(arg) As Boolean
    If IsObject(arg) Then
        Exit Function
    End If

    If Not IsArray(arg) Then
        Exit Function
    End If

    If arrHasDim(arg, 1) Then
        isVect = Not arrHasDim(arg, 2)
    End If
End Function

'"mat" = array of two and only two dimensions
Public Function isMat(arg) As Boolean
    If IsObject(arg) Then
        Exit Function
    End If

    If Not IsArray(arg) Then
        Exit Function
    End If

    If arrHasDim(arg, 2) Then
        isMat = Not arrHasDim(arg, 3)
    End If
End Function

Note the link to Chip Pearson's excellent web site: http://www.cpearson.com/excel/VBAArrays.htm

Also see: How do I determine if an array is initialized in VB6?. I personally don't like the undocumented behavior it relies on, and performance is rarely that important in the Excel VBA code I'm writing, but it's interesting nonetheless.