Reputation: 643
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)?
Upvotes: 11
Views: 15197
Reputation: 6140
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 CopyMemory
s to get the pointers and finally the Integer result.
UPDATE: This version should work on both 32 bit and 64 bit systems (original preserved below the break for posterity):
Option Explicit
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As Integer)
Public Function GetDims(VarSafeArray As Variant) As Integer
Dim variantType As Integer
Dim pointer As LongPtr
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, LenB(pointer)
'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, LenB(pointer)
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
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
Upvotes: 10
Reputation: 9948
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:
Application.Index(arr, 0, 1)
.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.
Upvotes: 1
Reputation: 1000
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
Upvotes: 2
Reputation: 53663
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
Upvotes: 13
Reputation: 6140
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
Upvotes: 14
Reputation: 1571
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
Upvotes: 5