VBA checks if array is one-dimensional

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

I want to be able to find out if an array has only one row.

UBound doesn't seem useful. 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 <Subscript out of range> .

I also saw this Microsoft help page to determine the number of dimensions in an array. This is a very terrible decision that involves using an error handler.

How to determine if an array has only one row (hopefully without using an error handler)?

+6
vba excel-vba excel
Jul 07 '14 at 14:32
source share
4 answers

If you REALLY want to avoid using On Error , you can use the knowledge of SAFEARRAY and VARIANT structures used to store arrays under covers to extract size information from which it is actually stored in memory. Put 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 
+8
Jul 07 '14 at 15:04
source share

I realized that my original answer could be simplified, not VARIANT and SAFEARRAY , which are defined as VBA types, all that is needed is a few CopyMemory to get pointers and finally the result of Integer.

Here is the simplest full GetDims that checks dimensions directly through 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 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 not an array... Type mismatch maybe? End If End Function 
+5
Oct 24 '14 at 20:35
source share

I know that you want to avoid using an error handler, but if that is good enough for Chip Pearson, that will be enough for me. This code (as well as a number of other very useful array functions) can be found on its website:

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

Create a custom function:

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

What calls the Chip 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 NumberOfArrayDimensions = Ndx - 1 End Function 
+4
Jul 07 '14 at 15:09
source share

For a two-dimensional array (or larger) 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 
+3
Jul 07 '14 at 2:48
source share



All Articles