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

10

37

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

Adenoid answered 1/8, 2011 at 17:16 Comment(1)
@chrisneilsen what made you decide to close as dupes this way, and not the other way arround as I suggested? I think the answers to this question are far more diverse, and thus helpful to a larger audience.Sessile
Q
37
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.

Quinquefid answered 1/8, 2011 at 17:27 Comment(5)
That this is the best solution is horrifying to me. It blows me away that MSDN has had what is basically this solution posted on their site since Excel 2000, and didn't fix it. I think newer versions have a .Rank property, but this survived for close to a decade.Brach
Sorry for resurrecting a dead thread, but I thought I'd point out for anyone using this that you'll want to define that function as Long rather than Integer as there is the possibility that it will return a number of dimensions in excess of 32,767 (according to the MDSN article there's a limit of 60,000 dimensions. Admittedly it is a rather slim possibility.Phthalein
You should remove the trailing line-continuators in On Error GoTo Err: and Do While True:Olibanum
I have updated the code: the ":" and Integer->Long problems are fixed.Dharana
@Phthalein Your link is dead.Tiny
V
16

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
Virago answered 8/2, 2016 at 17:30 Comment(5)
The compiler directives stopped my crashes. ThanksPeder
This produces unreliable results with variables without parentheses Dim list : list = Array(1, 2, 3)Olibanum
@ThunderFrame, thanks. There were indeed an issue with the case from your comment.Virago
This appears to not be capable of handling ranges Eg [A1:A1] or [A1:B2]Butterfly
@TaylorScott Did you try to put the range into an array first, before you pass the array to this fx? TempArray = [A1:D20] : NumDims = GetDims (TempArray)Wineglass
P
9

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
Pig answered 1/8, 2011 at 17:28 Comment(3)
That's a valid (and well designed) solution... and very similar to @cularis's.Midrib
Yeah, I think the only difference is that cularis's uses 2 variables, and this uses 1, and while loop vs for loop. The one thing I personally like about the MS solution is the exlicit nature of it. Calling out the maximum (60000), starting the loop at 1 (not 0), the fact that it's clear it's searching for an error, and such. Functionality-wise, there is no difference I think.Pig
Doesn't compile as it. Needed Dim ErrorCheck for those who use Option Explicit top of module.Denten
P
9

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

Padus answered 1/8, 2011 at 21:3 Comment(5)
"Do you really have a bunch of arrays of unknown dimension count floating around?" I've written boilerplate array manipulation functions (e.g. PowArray(arr,p) which raises all the array elements to some power p) which transparently accept arr with arbitrary numbers of dimensions. It starts by testing for Select Case NumberOfArrayDimensions(arr) and each Case implements one of those numbers (have to be coded separately, manually, loops and all — I'm up to n=3 in most functions). Not a pretty implementation on the inside, but very nice and clean on the outside, and works beautifully.Boutin
@Jean-FrançoisCorbett, sure, but I'd submit that you still don't need a routine that finds an arbitrary number of dimensions. Just my opinion, but if you know n=1, 2, or 3, you should test for those specifically. If I'm looking at code and I see a call to a general "NumberOfArrayDimensions" function I'd figure that the array being passed might have any rank, not just 1, 2, or 3. But in your case you know it won't be 4+ and so the code should probably reflect that. And if you know at call time that, say, n=2, you should just call your 2-D manipulation function directly.Padus
Very nice code, excellent explanation and links to additional informationSpousal
"Do you really have a bunch of arrays of unknown dimension count floating around?" - Yes. When the goal is create a VBA function that can be used in worksheet formulas AND with VBA arrays, the fx may need to determine whether it's a 1D VBA array or a 2D worksheet array.Wineglass
I cover that case explicitly in the answer though, and in the comments above. Simpler and more clear to just check for those 1-D and 2-D cases directly. Admittedly, this kind of thing rarely matters at the typical small scale of most Excel/VBA code. But a function that expects an arbitrary number of dimensions has to be tested with such, and using it communicates to other programmers that a 42-dimensional array might just be a thing in this application. Don't build it if You Ain't Gonna Need It!Padus
K
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
Kowatch answered 11/12, 2013 at 16:54 Comment(2)
This is a great solution, but it seems only to work if the array is explicitly dimensioned in when the variable is defined.Peder
@Peder I'm not sure, and I don't have time to check, but I actually have a simpler solution here that definitely works with both.Kowatch
D
1

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.

Denten answered 4/8, 2016 at 16:44 Comment(0)
B
1

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
Bootjack answered 20/7, 2020 at 22:56 Comment(0)
C
0
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
Claudicant answered 19/6, 2017 at 11:10 Comment(0)
T
-1

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.

Turnbuckle answered 2/6, 2016 at 16:22 Comment(4)
This is the same as the top solution.Marou
Nope, this solution doesn't rely on an error to function properly.Turnbuckle
I got "Array Index out of bounds" after I add "Dim arr(20, 10) As Integer : Var = arr" next line to comment "generate your variant here". I suppose you know the OP wants to get the number of dimensions instead of number of elements? ("Dim arr(1 to 5) as Integer" still fails, anyway)Exeunt
Even a zero-based "Dim arr(5) as Integer" doesn't work! Please test your code before answeringExeunt
D
-2

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

Drag answered 2/7, 2014 at 12:55 Comment(1)
I think the OP was asking for the number of dimensions, not the number of elements.Cesta

© 2022 - 2024 — McMap. All rights reserved.