Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VBA check if array is one dimensional

Tags:

excel

vba

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)?

like image 938
Alec Avatar asked Jul 07 '14 14:07

Alec


2 Answers

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
like image 112
Blackhawk Avatar answered Oct 24 '22 20:10

Blackhawk


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
like image 11
David Zemens Avatar answered Oct 24 '22 20:10

David Zemens