I am a supporter of
St. Joseph's hospice.
 If you find this site useful or if it helped you, consider a small donation to
St. Joseph's, please.

Information on
St. Joseph's

JustGiving - Sponsor me now!

 

ArrayDim

How do you determine the number of dimensions of an array?

Function ArrayDim(v As Variant) As Long
'Returns number of dimensions of an array or 0 for
'an undimensioned array or -1 if no array at all.
'Reverse("moc.LiborPlus.www") V0.1 PB 10-May-2010
Dim i As Long
ArrayDim = -1
If Not IsArray(v) Then Exit Function
On Error Resume Next 'Please read http://sulprobil.com/html/error_trapping.html
Err.Clear
Do While IsNumeric(UBound(v, i + 1))
    If Err.Number <> 0 Then Exit Do
    i = i + 1
Loop
ArrayDim = i
End Function

Another version, inspired by Bob Phillips and by Rick Rothstein:
Function DimCount(v As Variant) As Long
'Returns number of dimensions of an array or 0 for
'an undimensioned array or -1 if no array at all.
'Reverse("moc.LiborPlus.www") V0.1 PB 11-May-2010
    On Error Resume Next 'Please read http://sulprobil.com/html/error_trapping.html
    Do
        DimCount = DimCount - IsNumeric(UBound(v, DimCount + 1))
    Loop Until Err.Number
    DimCount = DimCount + Not IsArray(v)
End Function

This robust and fast code is from R. B. Smissaert:

Declare Sub CopyMemory Lib "kernel32" Alias _
                       "RtlMoveMemory" (pDst As Any, _
                                        pSrc As Any, _
                                        ByVal ByteLen As Long)

Function ArrayTester(arr As Variant) As Integer
  '-----------------------------------------------------------------
  ' will return:
  ' -1 if not an array
  ' 0  if an un-dimmed array
  ' 1  or more indicating the number of dimensions of a dimmed array
  '-----------------------------------------------------------------
  Dim ptr As Long
  Dim VType As Integer

  Const VT_BYREF = &H4000&

  'get the real VarType of the argument
  'this is similar to VarType(), but returns also the VT_BYREF bit
  CopyMemory VType, arr, 2

  'exit if not an array
  If (VType And vbArray) = 0 Then
    ArrayTester = -1
    Exit Function
  End If

  'get the address of the SAFEARRAY descriptor
  'this is stored in the second half of the
  'Variant parameter that has received the array
  CopyMemory ptr, ByVal VarPtr(arr) + 8, 4

  'see whether the routine was passed a Variant
  'that contains an array, rather than directly an array
  'in the former case ptr already points to the SA structure.
  'Thanks to Monte Hansen for this fix
  If (VType And VT_BYREF) Then
    ' ptr is a pointer to a pointer
    CopyMemory ptr, ByVal ptr, 4
  End If

  'get the address of the SAFEARRAY structure
  'this is stored in the descriptor

  'get the first word of the SAFEARRAY structure
  'which holds the number of dimensions
  '...but first check that saAddr is non-zero, otherwise
  'this routine bombs when the array is uninitialized
  '(Thanks to VB2TheMax aficionado Thomas Eyde for
  ' suggesting this edit to the original routine.)
  If ptr Then
    CopyMemory ArrayTester, ByVal ptr, 2
  End If

End Function

Sulprobil   Get it done   Contact   Disclaimer   Download