VBA check if array is one dimensional

Question

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\

Answer 1

If you REALLY want to avoid using On Error, you can use knowledge of the SAFEARRAY and VARIANT structures used to store arrays under the covers to extract the dimension information from where it's actually stored in memory. Place the following in a module called mdlSAFEARRAY

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

Private Type SAFEARRAY
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
End Type

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

Private Enum tagVARENUM
    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
    CopyMemory VarPtr(varArray.vt), VarPtr(VarSafeArray), 16&
    If varArray.vt And (tagVARENUM.VT_ARRAY Or tagVARENUM.VT_BYREF) Then
        CopyMemory VarPtr(lpSAFEARRAY), varArray.lpSAFEARRAY, 4&
        If Not lpSAFEARRAY = 0 Then
            CopyMemory VarPtr(sArr), lpSAFEARRAY, LenB(sArr)
            GetDims = sArr.cDims
        Else
            GetDims = 0  'The array is uninitialized
        End If
    Else
        GetDims = 0  'Not an array - might want an error instead
    End If
End Function

Here is a quick test function to show usage:

Public Sub testdims()
    Dim anotherarr(1, 2, 3) As Byte
    Dim myarr() As Long
    Dim strArr() As String
    ReDim myarr(9)
    ReDim strArr(12)
    Debug.Print GetDims(myarr)
    Debug.Print GetDims(anotherarr)
    Debug.Print GetDims(strArr)
End Sub