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

Question

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

Answer 1

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.

Answer 2

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

Answer 3

For arrays, MS has a nice method that involves looping through until an error occurs.

"This routine tests the array named Xarray by testing the LBound of each dimension. Using a For...Next loop, the routine cycles through the number of possible array dimensions, up to 60000, until an error is generated. Then the error handler takes the counter step that the loop failed on, subtracts one (because the previous one was the last one without an error), and displays the result in a message box...."

http://support.microsoft.com/kb/152288

Cleaned-up version of code (decided to write as a function, not sub):

Function NumberOfDimensions(ByVal vArray As Variant) As Long

Dim dimnum As Long
On Error GoTo FinalDimension

For dimnum = 1 To 60000
    ErrorCheck = LBound(vArray, dimnum)
Next

FinalDimension:
    NumberOfDimensions = dimnum - 1

End Function

Answer 4

@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.

Answer 5

Microsoft has documented the structure of VARIANT and SAFEARRAY, and using those you can parse the binary data to get the dimensions.

Create a normal code module. I call mine "mdlDims". You would use it by calling the simple function 'GetDims' and passing it an array.

Option Compare Database
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (var() As Any) As Long

'http://msdn.microsoft.com/en-us/library/windows/desktop/ms221482(v=vs.85).aspx
Private Type SAFEARRAY
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
End Type

'Variants are all 16 bytes, but they are split up differently based on the contained type
'VBA doesn't have the ability to Union, so a Type is limited to representing one layout
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms221627(v=vs.85).aspx
Private Type ARRAY_VARIANT
    vt As Integer
    wReserved1 As Integer
    wReserved2 As Integer
    wReserved3 As Integer
    lpSAFEARRAY As Long
    data(4) As Byte
End Type

'http://msdn.microsoft.com/en-us/library/windows/desktop/ms221170(v=vs.85).aspx
Private Enum VARENUM
    VT_EMPTY = &H0
    VT_NULL
    VT_I2
    VT_I4
    VT_R4
    VT_R8
    VT_CY
    VT_DATE
    VT_BSTR
    VT_DISPATCH
    VT_ERROR
    VT_BOOL
    VT_VARIANT
    VT_UNKNOWN
    VT_DECIMAL
    VT_I1 = &H10
    VT_UI1
    VT_UI2
    VT_I8
    VT_UI8
    VT_INT
    VT_VOID
    VT_HRESULT
    VT_PTR
    VT_SAFEARRAY
    VT_CARRAY
    VT_USERDEFINED
    VT_LPSTR
    VT_LPWSTR
    VT_RECORD = &H24
    VT_INT_PTR
    VT_UINT_PTR
    VT_ARRAY = &H2000
    VT_BYREF = &H4000
End Enum

Public Function GetDims(VarSafeArray As Variant) As Integer
    Dim varArray As ARRAY_VARIANT
    Dim lpSAFEARRAY As Long
    Dim sArr As SAFEARRAY

    'Inspect the Variant
    CopyMemory VarPtr(varArray.vt), VarPtr(VarSafeArray), 16&

    'If the Variant is pointing to an array...
    If varArray.vt And (VARENUM.VT_ARRAY Or VARENUM.VT_BYREF) Then

        'Get the pointer to the SAFEARRAY from the Variant
        CopyMemory VarPtr(lpSAFEARRAY), varArray.lpSAFEARRAY, 4&

        'If the pointer is not Null
        If Not lpSAFEARRAY = 0 Then
            'Read the array dimensions from the SAFEARRAY
            CopyMemory VarPtr(sArr), lpSAFEARRAY, LenB(sArr)

            'and return them
            GetDims = sArr.cDims
        Else
            'The array is uninitialized
            GetDims = 0
        End If
    Else
        'Not an array, you could choose to raise an error here
        GetDims = 0
    End If
End Function

Answer 6

I presume you mean without using On Error Resume Next which most programmers dislike and which also means that during debugging you can't use 'Break On All Errors' to get the code to stop dead (Tools->Options->General->Error Trapping->Break on All Errors).

For me one solution is to bury any On Error Resume Next into a compiled DLL, in the old days this would have been VB6. Today you could use VB.NET but I choose to use C#.

If Visual Studio is available to you then here is some source. It will return a dictionary, the Dicitionary.Count will return the number of dimensions. The items will also contain the LBound and UBound as a concatenated string. I'm always querying an array not just for its dimensions but also for LBound and UBound of those dimensions so I put these together and return a whole bundle of info in a Scripting Dictionary

Here is C# source, start a Class Library calling it BuryVBAErrorsCS, set ComVisible(true) add a reference to COM library 'Microsoft Scripting Runtime', Register for Interop.

using Microsoft.VisualBasic;
using System;
using System.Runtime.InteropServices;

namespace BuryVBAErrorsCS
{
    // Requires adding a reference to COM library Microsoft Scripting Runtime
    // In AssemblyInfo.cs set ComVisible(true);
    // In Build tab check 'Register for Interop'
    public interface IDimensionsAndBounds
    {
        Scripting.Dictionary DimsAndBounds(Object v);
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(IDimensionsAndBounds))]
    public class CDimensionsAndBounds : IDimensionsAndBounds
    {
        public Scripting.Dictionary DimsAndBounds(Object v)
        {
            Scripting.Dictionary dicDimsAndBounds;
            dicDimsAndBounds = new Scripting.Dictionary();

            try
            {
                for (Int32 lDimensionLoop = 1; lDimensionLoop < 30; lDimensionLoop++)
                {
                    long vLBound = Information.LBound((Array)v, lDimensionLoop);
                    long vUBound = Information.UBound((Array)v, lDimensionLoop);
                    string concat = (string)vLBound.ToString() + " " + (string)vUBound.ToString();
                    dicDimsAndBounds.Add(lDimensionLoop, concat);
                }
            }
            catch (Exception)
            {

            }

            return dicDimsAndBounds;
        }
    }
}

For Excel client VBA code here is some source

Sub TestCDimensionsAndBounds()
    '* requires Tools->References->BuryVBAErrorsCS.tlb
    Dim rng As Excel.Range
    Set rng = ThisWorkbook.Worksheets.Item(1).Range("B4:c7")

    Dim v As Variant
    v = rng.Value2

    Dim o As BuryVBAErrorsCS.CDimensionsAndBounds
    Set o = New BuryVBAErrorsCS.CDimensionsAndBounds

    Dim dic As Scripting.Dictionary
    Set dic = o.DimsAndBounds(v)

    Debug.Assert dic.Items()(0) = "1 4"
    Debug.Assert dic.Items()(1) = "1 2"


    Dim s(1 To 2, 2 To 3, 3 To 4, 4 To 5, 5 To 6)
    Set dic = o.DimsAndBounds(s)
    Debug.Assert dic.Items()(0) = "1 2"
    Debug.Assert dic.Items()(1) = "2 3"
    Debug.Assert dic.Items()(2) = "3 4"
    Debug.Assert dic.Items()(3) = "4 5"
    Debug.Assert dic.Items()(4) = "5 6"


    Stop
End Sub

NOTE WELL: This answer handles grid variants pulled off a worksheet with Range.Value as well as arrays created in code using Dim s(1) etc.! Some of the other answers do not do this.

Answer 7

I like to use the fact that with an error, the new variable-value is not charged.

To get the dimension (A_Dim) of an Array (vArray) you can use following code:

On Error Resume Next
    A_Dim = -1
    Do Until A = "X"
        A_Dim = A_Dim + 1
        A = "X"
        A = UBound(vArray, A_Dim + 1)
    Loop
On Error GoTo 0

Answer 8

Function ArrayDimension(ByRef ArrayX As Variant) As Byte
    Dim i As Integer, a As String, arDim As Byte
    On Error Resume Next
    i = 0
    Do
        a = CStr(ArrayX(0, i))
        If Err.Number > 0 Then
            arDim = i
            On Error GoTo 0
            Exit Do
        Else
             i = i + 1
        End If
    Loop
    If arDim = 0 Then arDim = 1
    ArrayDimension = arDim
End Function

Answer 9

I found a pretty simple way to check, probably laden with a bunch of coding faux pas, incorrect lingo, and ill advised techniques but never the less:

Dim i as Long
Dim VarCount as Long
Dim Var as Variant

'generate your variant here

i = 0
VarCount = 0
recheck1:
  If IsEmpty(Var(i)) = True Then GoTo VarCalc
    i = i + 1
    GoTo recheck1
VarCalc:
  VarCount= i - 1

Note: VarCount will obviously return a negative number if Var(0) doesn't exist. VarCount is the max reference number for use with Var(i), i is the number of variants you have.

Answer 10

What about just using ubound(var) + 1? That should give you the last element of most of variables (unless it's a custom range, but in that case you should know that info already). The range of a conventional variable (for instance, when using the split function) starts with 0; ubound gives you the last item of the variable. So if you have a variable with 8 elements, for instance, it will go from 0 (lbound) to 7 (ubound), and you can know the quantity of elements just adding ubound(var) + 1. For example:

Public Sub PrintQntElements()
    Dim str As String
    Dim var As Variant
    Dim i As Integer

    str = "Element1!Element2!Element3!Element4!Element5!Element6!Element7!Element8"
    var = Split(str, "!")
    i = UBound(var) + 1
    Debug.Print "First element: " & LBound(var)
    Debug.Print "Last element: " & UBound(var)
    Debug.Print "Quantity of elements: " & i
End Sub

It will print this output to the Inmediate window:
First element: 0
Last element: 7
Quantity of elements: 8

Also, if you are not sure that the first element (lbound) is 0, you can just use:

i = UBound(var) - LBound(var) + 1