'VBA check if array is one dimensional

I have an array (that comes from SQL) and can potentially have one or more rows.

I want to be able to figure out if the array has just one row.

UBound doesn't seem to be helpful. For 2-dimensional arrays UBound(A,1) and UBound(A,2) returns the number of rows and columns respectively, but when the array has only one row, UBound(A,1) returns the number of columns and UBound(A,2) returns a <Subscript out of range>.

I have also seen this Microsoft help page for determining the number of dimensions in an array. It is a very horrifying solution that involves using the error handler.

How can I determine whether the array has just one row (hopefully without using the error handler)?



Solution 1:[1]

I know you want to avoid using the error handler, but if it's good enough for Chip Pearson, it's good enough for me. This code (as well as a number of other very helpful array functions) can be found on his site:

http://www.cpearson.com/excel/vbaarrays.htm

Create a custom function:

Function IsArrayOneDimensional(arr as Variant) As Boolean
    IsArrayOneDimensional = (NumberOfArrayDimensions(arr) = 1)
End Function

Which calls Chip's function:

Public Function NumberOfArrayDimensions(arr As Variant) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NumberOfArrayDimensions
' This function returns the number of dimensions of an array. An unallocated dynamic array
' has 0 dimensions. This condition can also be tested with IsArrayEmpty.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Integer
Dim Res As Integer
On Error Resume Next
' Loop, increasing the dimension index Ndx, until an error occurs.
' An error will occur when Ndx exceeds the number of dimension
' in the array. Return Ndx - 1.
Do
    Ndx = Ndx + 1
    Res = UBound(arr, Ndx)
Loop Until Err.Number <> 0

Err.Clear

NumberOfArrayDimensions = Ndx - 1

End Function

Solution 2:[2]

I realized that my original answer can be simplified - rather than having the VARIANT and SAFEARRAY structures defined as VBA Types, all that is needed is a few CopyMemorys to get the pointers and finally the Integer result.

Here is the simplest complete GetDims that checks the dimensions directly through the variables in memory:

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)

Public Function GetDims(VarSafeArray As Variant) As Integer
    Dim variantType As Integer
    Dim pointer As Long
    Dim arrayDims As Integer

    CopyMemory VarPtr(variantType), VarPtr(VarSafeArray), 2& 'the first 2 bytes of the VARIANT structure contain the type

    If (variantType And &H2000) > 0 Then 'Array (&H2000)
        'If the Variant contains an array or ByRef array, a pointer for the SAFEARRAY or array ByRef variant is located at VarPtr(VarSafeArray) + 8
        CopyMemory VarPtr(pointer), VarPtr(VarSafeArray) + 8, 4&

        'If the array is ByRef, there is an additional layer of indirection through another Variant (this is what allows ByRef calls to modify the calling scope).
        'Thus it must be dereferenced to get the SAFEARRAY structure
        If (variantType And &H4000) > 0 Then 'ByRef (&H4000)
            'dereference the pointer to pointer to get the actual pointer to the SAFEARRAY
            CopyMemory VarPtr(pointer), pointer, 4&
        End If
        'The pointer will be 0 if the array hasn't been initialized
        If Not pointer = 0 Then
            'If it HAS been initialized, we can pull the number of dimensions directly from the pointer, since it's the first member in the SAFEARRAY struct
            CopyMemory VarPtr(arrayDims), pointer, 2&
            GetDims = arrayDims
        Else
            GetDims = 0 'Array not initialized
        End If
    Else
        GetDims = 0 'It's not an array... Type mismatch maybe?
    End If
End Function

Solution 3:[3]

For a 2D array (or more dimensions), use this function:

Function is2d(a As Variant) As Boolean
    Dim l As Long
    On Error Resume Next
    l = LBound(a, 2)
    is2d = Err = 0
End Function

which gives :

Sub test()
    Dim d1(2) As Integer, d2(2, 2) As Integer,d3(2, 2, 2) As Integer
    Dim b1, b2, b3 As Boolean

    b1 = is2d(d1) ' False
    b2 = is2d(d2) ' True
    b3 = is2d(d3) ' True

    Stop
End Sub

Solution 4:[4]

I found Blackhawks's accepted and revised answer very instructive, so I played around with it and learned some useful things from it. Here's a slightly modified version of that code that includes a test sub at the bottom.

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
    ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)

Public Function GetDims(VarSafeArray As Variant) As Integer
    Dim variantType As Integer
    Dim pointer As Long
    Dim arrayDims As Integer

    'The first 2 bytes of the VARIANT structure contain the type:
    CopyMemory VarPtr(variantType), VarPtr(VarSafeArray), 2&

    If Not (variantType And &H2000) > 0 Then
    'It's not an array. Raise type mismatch.
        Err.Raise (13)
    End If

    'If the Variant contains an array or ByRef array, a pointer for the _
        SAFEARRAY or array ByRef variant is located at VarPtr(VarSafeArray) + 8:
    CopyMemory VarPtr(pointer), VarPtr(VarSafeArray) + 8, 4&

    'If the array is ByRef, there is an additional layer of indirection through_
    'another Variant (this is what allows ByRef calls to modify the calling scope).
    'Thus it must be dereferenced to get the SAFEARRAY structure:
    If (variantType And &H4000) > 0 Then 'ByRef (&H4000)
        'dereference the pointer to pointer to get actual pointer to the SAFEARRAY
        CopyMemory VarPtr(pointer), pointer, 4&
    End If
    'The pointer will be 0 if the array hasn't been initialized
    If Not pointer = 0 Then
        'If it HAS been initialized, we can pull the number of dimensions directly _
            from the pointer, since it's the first member in the SAFEARRAY struct:
        CopyMemory VarPtr(arrayDims), pointer, 2&
        GetDims = arrayDims
    Else
        GetDims = 0 'Array not initialized
    End If
End Function

Sub TestGetDims()
' Tests GetDims(). Should produce the following output to Immediate Window:
'
' 1             One
' 2             Two
' Number of array dimensions: 2

    Dim myArray(2, 2) As Variant
    Dim iResult As Integer
    myArray(0, 0) = 1
    myArray(1, 0) = "One"
    myArray(0, 1) = 2
    myArray(1, 1) = "Two"

    Debug.Print myArray(0, 0), myArray(1, 0)
    Debug.Print myArray(0, 1), myArray(1, 1)

    iResult = GetDims(myArray)

    Debug.Print "Number of array dimensions: " & iResult
End Sub

Solution 5:[5]

Identify 1-row arrays without Error handling or API functions

"I want to be able to figure out if the array has just one row."

To solve OP's requirement focussing on arrays already dimensioned as 1- and 2-dim arrays, it isn't necessary to determine the array's actual dimension, it suffices to get the number of its "rows". So I came across the following surprisingly simple solution considering the following:

  • It's possible to slice 1-dim or 2-dim arrays to isolate their first "column" via Application.Index(arr, 0, 1).
  • An eventual UBound now will show the correct number of rows, especially for the asked one-row case.
Function UBndOne(arr) As Long
'Purp: get rows count of (array) input
'Note: returns 1 as the function result for 
'    a) one-dimensional arrays 
'    b) 2-dim arrays with only one row
'      UBound(arr,1) isn't helpful for 1-dim array as it would return the number of elements
    UBndOne = UBound(Application.Index(arr, 0, 1))
End Function

Side note: The combined code UBound(Application.Index(arr, 0, 1)) could be applied even upon other data types than arrays, returning as well 1 as function result.

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Community
Solution 2 Community
Solution 3
Solution 4 Egalth
Solution 5 T.M.