How do I properly instantiate a VBA array and check if it's empty? [duplicate] - vba

Passing an undimensioned array to the VB6's Ubound function will cause an error, so I want to check if it has been dimensioned yet before attempting to check its upper bound. How do I do this?

Note: the code has been updated, the original version can be found in the revision history (not that it is useful to find it). The updated code does not depend on the undocumented GetMem4 function and correctly handles arrays of all types.
Note for VBA users: This code is for VB6 which never got an x64 update. If you intend to use this code for VBA, see https://stackoverflow.com/a/32539884/11683 for the VBA version. You will only need to take the CopyMemory declaration and the pArrPtr function, leaving the rest.
I use this:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
Private Const VT_BYREF As Long = &H4000&
' When declared in this way, the passed array is wrapped in a Variant/ByRef. It is not copied.
' Returns *SAFEARRAY, not **SAFEARRAY
Public Function pArrPtr(ByRef arr As Variant) As Long
'VarType lies to you, hiding important differences. Manual VarType here.
Dim vt As Integer
CopyMemory ByVal VarPtr(vt), ByVal VarPtr(arr), Len(vt)
If (vt And vbArray) <> vbArray Then
Err.Raise 5, , "Variant must contain an array"
End If
'see https://msdn.microsoft.com/en-us/library/windows/desktop/ms221627%28v=vs.85%29.aspx
If (vt And VT_BYREF) = VT_BYREF Then
'By-ref variant array. Contains **pparray at offset 8
CopyMemory ByVal VarPtr(pArrPtr), ByVal VarPtr(arr) + 8, Len(pArrPtr) 'pArrPtr = arr->pparray;
CopyMemory ByVal VarPtr(pArrPtr), ByVal pArrPtr, Len(pArrPtr) 'pArrPtr = *pArrPtr;
Else
'Non-by-ref variant array. Contains *parray at offset 8
CopyMemory ByVal VarPtr(pArrPtr), ByVal VarPtr(arr) + 8, Len(pArrPtr) 'pArrPtr = arr->parray;
End If
End Function
Public Function ArrayExists(ByRef arr As Variant) As Boolean
ArrayExists = pArrPtr(arr) <> 0
End Function
Usage:
? ArrayExists(someArray)
Your code seems to do the same (testing for SAFEARRAY** being NULL), but in a way which I would consider a compiler bug :)

I just thought of this one. Simple enough, no API calls needed. Any problems with it?
Public Function IsArrayInitialized(arr) As Boolean
Dim rv As Long
On Error Resume Next
rv = UBound(arr)
IsArrayInitialized = (Err.Number = 0)
End Function
Edit: I did discover a flaw with this related to the behavior of the Split function (actually I'd call it a flaw in the Split function). Take this example:
Dim arr() As String
arr = Split(vbNullString, ",")
Debug.Print UBound(arr)
What is the value of Ubound(arr) at this point? It's -1! So, passing this array to this IsArrayInitialized function would return true, but attempting to access arr(0) would cause a subscript out of range error.

Here's what I went with. This is similar to GSerg's answer, but uses the better documented CopyMemory API function and is entirely self-contained (you can just pass the array rather than ArrPtr(array) to this function). It does use the VarPtr function, which Microsoft warns against, but this is an XP-only app, and it works, so I'm not concerned.
Yes, I know this function will accept anything you throw at it, but I'll leave the error checking as an exercise for the reader.
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Function ArrayIsInitialized(arr) As Boolean
Dim memVal As Long
CopyMemory memVal, ByVal VarPtr(arr) + 8, ByVal 4 'get pointer to array
CopyMemory memVal, ByVal memVal, ByVal 4 'see if it points to an address...
ArrayIsInitialized = (memVal <> 0) '...if it does, array is intialized
End Function

I found this:
Dim someArray() As Integer
If ((Not someArray) = -1) Then
Debug.Print "this array is NOT initialized"
End If
Edit: RS Conley pointed out in his answer that (Not someArray) will sometimes return 0, so you have to use ((Not someArray) = -1).

Both methods by GSerg and Raven are undocumented hacks but since Visual BASIC 6 is no longer being developed then it is not a issue. However Raven's example doesn't work on all machines. You have to test like this.
If (Not someArray) = -1 Then
On some machines it will return a zero on others some large negative number.

In VB6 there is a function called "IsArray", but it does not check if the array has been initialized. You will receive Error 9 - Subscript out of range if you attempt to use UBound on an uninitialized array. My method is very similar to S J's, except it works with all variable types and has error handling. If a non-array variable is checked, you will receive Error 13 - Type Mismatch.
Private Function IsArray(vTemp As Variant) As Boolean
On Error GoTo ProcError
Dim lTmp As Long
lTmp = UBound(vTemp) ' Error would occur here
IsArray = True: Exit Function
ProcError:
'If error is something other than "Subscript
'out of range", then display the error
If Not Err.Number = 9 Then Err.Raise (Err.Number)
End Function

Since wanted comment on here will post answer.
Correct answer seems is from #raven:
Dim someArray() As Integer
If ((Not someArray) = -1) Then
Debug.Print "this array is NOT initialized"
End If
When documentation or Google does not immediately return an explanation people tend to call it a hack.
Although what seems to be the explanation is that Not is not only a Logical, it is also a Bitwise operator, so it handles the bit representation of structures, rather than Booleans only.
For example of another bitwise operation is here:
Dim x As Integer
x = 3 And 5 'x=1
So the above And is also being treated as a bitwise operator.
Furthermore, and worth to check, even if not the directly related with this,
The Not operator can be overloaded, which means that a class or
structure can redefine its behavior when its operand has the type of
that class or structure.
Overloading
Accordingly, Not is interpreting the array as its bitwise representation and it distinguishes output when array is empty or not like differently in the form of signed number. So it can be considered this is not a hack, is just an undocumentation of the array bitwise representation, which Not here is exposing and taking advantage of.
Not takes a single operand and inverts all the bits, including the
sign bit, and assigns that value to the result. This means that for
signed positive numbers, Not always returns a negative value, and for
negative numbers, Not always returns a positive or zero value.
Logical Bitwise
Having decided to post since this offered a new approach which is welcome to be expanded, completed or adjusted by anyone who has access to how arrays are being represented in their structure. So if anyone offers proof it is actually not intended for arrays to be treated by Not bitwise we should accept it as not a hack and actually as best clean answer, if they do or do not offer any support for this theory, if it is constructive comment on this is welcome of course.

This is modification of raven's answer. Without using API's.
Public Function IsArrayInitalized(ByRef arr() As String) As Boolean
'Return True if array is initalized
On Error GoTo errHandler 'Raise error if directory doesnot exist
Dim temp As Long
temp = UBound(arr)
'Reach this point only if arr is initalized i.e. no error occured
If temp > -1 Then IsArrayInitalized = True 'UBound is greater then -1
Exit Function
errHandler:
'if an error occurs, this function returns False. i.e. array not initialized
End Function
This one should also be working in case of split function.
Limitation is you would need to define type of array (string in this example).

When you initialite the array put an integer or boolean with a flag = 1. and query this flag when you need.

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long
Private Type SafeArray
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
End Type
Private Function ArrayInitialized(ByVal arrayPointer As Long) As Boolean
Dim pSafeArray As Long
CopyMemory pSafeArray, ByVal arrayPointer, 4
Dim tArrayDescriptor As SafeArray
If pSafeArray Then
CopyMemory tArrayDescriptor, ByVal pSafeArray, LenB(tArrayDescriptor)
If tArrayDescriptor.cDims > 0 Then ArrayInitialized = True
End If
End Function
Usage:
Private Type tUDT
t As Long
End Type
Private Sub Form_Load()
Dim longArrayNotDimmed() As Long
Dim longArrayDimmed(1) As Long
Dim stringArrayNotDimmed() As String
Dim stringArrayDimmed(1) As String
Dim udtArrayNotDimmed() As tUDT
Dim udtArrayDimmed(1) As tUDT
Dim objArrayNotDimmed() As Collection
Dim objArrayDimmed(1) As Collection
Debug.Print "longArrayNotDimmed " & ArrayInitialized(ArrPtr(longArrayNotDimmed))
Debug.Print "longArrayDimmed " & ArrayInitialized(ArrPtr(longArrayDimmed))
Debug.Print "stringArrayNotDimmed " & ArrayInitialized(ArrPtr(stringArrayNotDimmed))
Debug.Print "stringArrayDimmed " & ArrayInitialized(ArrPtr(stringArrayDimmed))
Debug.Print "udtArrayNotDimmed " & ArrayInitialized(ArrPtr(udtArrayNotDimmed))
Debug.Print "udtArrayDimmed " & ArrayInitialized(ArrPtr(udtArrayDimmed))
Debug.Print "objArrayNotDimmed " & ArrayInitialized(ArrPtr(objArrayNotDimmed))
Debug.Print "objArrayDimmed " & ArrayInitialized(ArrPtr(objArrayDimmed))
Unload Me
End Sub

Based on all the information I read in this existing post this works the best for me when dealing with a typed array that starts as uninitialized.
It keeps the testing code consistent with the usage of UBOUND and It does not require the usage of error handling for testing.
It IS dependent on Zero Based Arrays (which is the case in most development).
Must not use "Erase" to clear the array. use alternative listed below.
Dim data() as string ' creates the untestable holder.
data = Split(vbNullString, ",") ' causes array to return ubound(data) = -1
If Ubound(data)=-1 then ' has no contents
' do something
End If
redim preserve data(Ubound(data)+1) ' works to increase array size regardless of it being empty or not.
data = Split(vbNullString, ",") ' MUST use this to clear the array again.

The easiest way to handle this is to insure that the array is initialized up front, before you need to check for the Ubound. I needed an array that was declared in the (General) area of the form code.
i.e.
Dim arySomeArray() As sometype
Then in the form load routine I redim the array:
Private Sub Form_Load()
ReDim arySomeArray(1) As sometype 'insure that the array is initialized
End Sub
This will allow the array to be re-defined at any point later in the program.
When you find out how big the array needs to be just redim it.
ReDim arySomeArray(i) As sometype 'i is the size needed to hold the new data

The title of the question asks how to determine if an array is initialized, but, after reading the question, it looks like the real problem is how to get the UBound of an array that is not initialized.
Here is my solution (to the the actual problem, not to the title):
Function UBound2(Arr) As Integer
On Error Resume Next
UBound2 = UBound(Arr)
If Err.Number = 9 Then UBound2 = -1
On Error GoTo 0
End Function
This function works in the following four scenarios, the first three that I have found when Arr is created by an external dll COM and the fourth when the Arr is not ReDim-ed (the subject of this question):
UBound(Arr) works, so calling UBound2(Arr) adds a little overhead, but doesn't hurt much
UBound(Arr) fails in in the function that defines Arr, but succeeds inside UBound2()
UBound(Arr) fails both in the function that defines Arr and in UBound2(), so the error handling does the job
After Dim Arr() As Whatever, before ReDim Arr(X)

For any variable declared as an array, you can easily check if the array is initialized by calling the SafeArrayGetDim API. If the array is initialized, then the return value will be non-zero, otherwise the function returns zero.
Note that you can't use this function with variants that contain arrays. Doing so will cause a Compile error (Type mismatch).
Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (psa() As Any) As Long
Public Sub Main()
Dim MyArray() As String
Debug.Print SafeArrayGetDim(MyArray) ' zero
ReDim MyArray(64)
Debug.Print SafeArrayGetDim(MyArray) ' non-zero
Erase MyArray
Debug.Print SafeArrayGetDim(MyArray) ' zero
ReDim MyArray(31, 15, 63)
Debug.Print SafeArrayGetDim(MyArray) ' non-zero
Erase MyArray
Debug.Print SafeArrayGetDim(MyArray) ' zero
ReDim MyArray(127)
Debug.Print SafeArrayGetDim(MyArray) ' non-zero
Dim vArray As Variant
vArray = MyArray
' If you uncomment the next line, the program won't compile or run.
'Debug.Print SafeArrayGetDim(vArray) ' <- Type mismatch
End Sub

If the array is a string array, you can use the Join() method as a test:
Private Sub Test()
Dim ArrayToTest() As String
MsgBox StringArrayCheck(ArrayToTest) ' returns "false"
ReDim ArrayToTest(1 To 10)
MsgBox StringArrayCheck(ArrayToTest) ' returns "true"
ReDim ArrayToTest(0 To 0)
MsgBox StringArrayCheck(ArrayToTest) ' returns "false"
End Sub
Function StringArrayCheck(o As Variant) As Boolean
Dim x As String
x = Join(o)
StringArrayCheck = (Len(x) <> 0)
End Function

My only problem with API calls is moving from 32-bit to 64-bit OS's.
This works with Objects, Strings, etc...
Public Function ArrayIsInitialized(ByRef arr As Variant) As Boolean
On Error Resume Next
ArrayIsInitialized = False
If UBound(arr) >= 0 Then If Err.Number = 0 Then ArrayIsInitialized = True
End Function

If ChkArray(MyArray)=True then
....
End If
Public Function ChkArray(ByRef b) As Boolean
On Error goto 1
If UBound(b) > 0 Then ChkArray = True
End Function

You can solve the issue with Ubound() function, check if the array is empty by retrieving total elements count using JScript's VBArray() object (works with arrays of variant type, single or multidimensional):
Sub Test()
Dim a() As Variant
Dim b As Variant
Dim c As Long
' Uninitialized array of variant
' MsgBox UBound(a) ' gives 'Subscript out of range' error
MsgBox GetElementsCount(a) ' 0
' Variant containing an empty array
b = Array()
MsgBox GetElementsCount(b) ' 0
' Any other types, eg Long or not Variant type arrays
MsgBox GetElementsCount(c) ' -1
End Sub
Function GetElementsCount(aSample) As Long
Static oHtmlfile As Object ' instantiate once
If oHtmlfile Is Nothing Then
Set oHtmlfile = CreateObject("htmlfile")
oHtmlfile.parentWindow.execScript ("function arrlength(arr) {try {return (new VBArray(arr)).toArray().length} catch(e) {return -1}}"), "jscript"
End If
GetElementsCount = oHtmlfile.parentWindow.arrlength(aSample)
End Function
For me it takes about 0.4 mksec for each element + 100 msec initialization, being compiled with VB 6.0.9782, so the array of 10M elements takes about 4.1 sec. The same functionality could be implemented via ScriptControl ActiveX.

There are two slightly different scenarios to test:
The array is initialised (effectively it is not a null pointer)
The array is initialised and has at least one element
Case 2 is required for cases like Split(vbNullString, ",") which returns a String array with LBound=0 and UBound=-1.
Here are the simplest example code snippets I can produce for each test:
Public Function IsInitialised(arr() As String) As Boolean
On Error Resume Next
IsInitialised = UBound(arr) <> 0.5
End Function
Public Function IsInitialisedAndHasElements(arr() As String) As Boolean
On Error Resume Next
IsInitialisedAndHasElements = UBound(arr) >= LBound(arr)
End Function

Either of these two ways is valid to detect an uninitialized array, but they must include the parentheses:
(Not myArray) = -1
(Not Not myArray) = 0

' Function CountElements return counted elements of an array.
' Returns:
' [ -1]. If the argument is not an array.
' [ 0]. If the argument is a not initialized array.
' [Count of elements]. If the argument is an initialized array.
Private Function CountElements(ByRef vArray As Variant) As Integer
' Check whether the argument is an array.
If (VarType(vArray) And vbArray) <> vbArray Then
' Not an array. CountElements is set to -1.
Let CountElements = -1
Else
On Error Resume Next
' Calculate number of elements in array.
' Scenarios:
' - Array is initialized. CountElements is set to counted elements.
' - Array is NOT initialized. CountElements is never set and keeps its
' initial value of zero (since an error is
' raised).
Let CountElements = (UBound(vArray) - LBound(vArray)) + 1
End If
End Function
' Test of function CountElements.
Dim arrStr() As String
Dim arrV As Variant
Let iCount = CountElements(arrStr) ' arrStr is not initialized, returns 0.
ReDim arrStr(2)
Let iCount = CountElements(arrStr) ' arrStr is initialized, returns 3.
ReDim arrStr(5 To 8)
Let iCount = CountElements(arrStr) ' arrStr is initialized, returns 4.
Let arrV = arrStr
Let iCount = CountElements(arrV) ' arrV contains a boxed arrStr which is initialized, returns 4
Erase arrStr
Let iCount = CountElements(arrStr) ' arrStr size is erased, returns 0.
Let iCount = CountElements(Nothing) ' Nothing is not an array, returns -1.
Let iCount = CountElements(Null) ' Null is not an array, returns -1.
Let iCount = CountElements(5) ' Figure is not an array, returns -1.
Let iCount = CountElements("My imaginary array") ' Text is not an array, returns -1.
Let iCount = CountElements(Array(1, 2, 3, 4, 5)) ' Created array of Integer elements, returns 5.
Let iCount = CountElements(Array("A", "B", "C")) ' Created array of String elements, returns 3.

I see a lot of suggestions online about how to tell if an array has been initialized. Below is a function that will take any array, check what the ubound of that array is, redimension the array to ubound +1 (with or without PRESERVER) and then return what the current ubound of the array is, without errors.
Function ifuncRedimUbound(ByRef byrefArr, Optional bPreserve As Boolean)
On Error GoTo err:
1: Dim upp%: upp% = (UBound(byrefArr) + 1)
errContinue:
If bPreserve Then
ReDim Preserve byrefArr(upp%)
Else
ReDim byrefArr(upp%)
End If
ifuncRedimUbound = upp%
Exit Function
err:
If err.Number = 0 Then Resume Next
If err.Number = 9 Then ' subscript out of range (array has not been initialized yet)
If Erl = 1 Then
upp% = 0
GoTo errContinue:
End If
Else
ErrHandler.ReportError "modArray", ifuncRedimUbound, "1", err.Number, err.Description
End If
End Function

This worked for me, any bug in this?
If IsEmpty(a) Then
Exit Function
End If
MSDN

Dim someArray() as Integer
If someArray Is Nothing Then
Debug.print "this array is not initialised"
End If

Related

How to find the number of dimensions that an array has?

Below is a piece of code where I need to store some info about a warning message by going through messages passed. The parameter passed itself is a variant which is set by an API call to SAPListOfMessages which returns an array of String. What I've noticed however is that whenever there is more than 1 warning, the list is 2D and messageList(x-1) obviously leads to an error because it's not a proper index. What's also strange is that the for each loop seems to ignore dimensions and somehow just flatten the array and loop through it as if it were 1D. The only way around this I see is checking how many dimensions the array has before doing anything else and hence my question. I wasn't able to find any info on getting the number of dimensions - I only found info about their bounds. Is it possible to find the number of dimensions of an array in VBA? If not, how would you suggest I tackle this problem?
Sub getOverlapWarnings(ByRef messageList As Variant, ByRef warnings As Dictionary)
Dim msg As Variant
Dim x As Integer
x = 1
'look for an overlap warning message in the list of messages
For Each msg In messageList
'look for the keyword 'overlap' in the list of messages
If InStr(1, msg, "overlap") <> 0 Then
warnings.Add messageList(x - 1), msg
End If
x = x + 1
Next msg
End Sub
Is it possible to find the number of dimensions of an array in VBA?
This approach increments the possible dimensions count, 60 being the built in maximum (c.f. comment):
Private Function nDim(ByVal vArray As Variant) As Long
' Purpose: get array dimension (MS)
Dim dimnum As Long
Dim ErrorCheck As Long ' OP: As Variant
On Error GoTo FinalDimension
For dimnum = 1 To 60 ' 60 being the absolute dimensions limitation
ErrorCheck = LBound(vArray, dimnum)
Next
' It's good use to formally exit a procedure before error handling
' (though theoretically this wouldn't needed in this special case - see comment)
Exit Function
FinalDimension:
nDim = dimnum - 1
End Function
Further links (thx #ChrisNeilson)
MS Using arrays
Big Array
An array has 2 bounds: Upper and Lower.
I think you're asking where the lower bound begins.
By default, the lower bound is zero. For example:
Sub test()
Dim arr
arr = Array("a", "b", "c")
Debug.Print "Lower: " & LBound(arr), "Upper: " & UBound(arr)
End Sub
returns: Lower: 0 Upper: 2 because the 3 elements have indices of 0, 1, and 2.
Some functionality may begin at 1 by default but it's rare. One example is filling an array with a range:
Sub test()
Dim arr
arr = Range("A2:A4")
Debug.Print "Lower: " & LBound(arr), "Upper: " & UBound(arr)
End Sub
...returns: Lower: 1 Upper: 3
If you fully declare the array, you can make the upper and lower bound whatever you want:
Sub test()
Dim arr(99 To 101) As String
arr(100) = "blah"
Debug.Print "Lower: " & LBound(arr), "Upper: " & UBound(arr)
End Sub
...returns: Lower: 99 Upper: 101, but an array with declared bounds won't work with many functions (like the previous examples.
You can also set the default lower bound with an statement at the very top of each module:
Option Base 1
...but there are so many places it doens't apply it's kind of useless. (More here.)
See also:
MSDN : Declaring Arrays (Fixed & Dynamic)
MSDN : LBound Function
MSDN : UBound Function
Here's a technique that doesn't require any looping through possible array dimensions. It reads the dimension count directly from the array definition itself.
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
Private Enum VariantTypes
VTx_Empty = vbEmpty '(0) Uninitialized
'...
VTx_Array = vbArray '(8192)
VTx_ByRef = &H4000 '(16384) Is an indirect pointer to the Variant's data
End Enum
Type VariantStruct 'NOTE - the added "X_..." prefixes force the VBE Locals window to display the elements in
'their correct adjacency order:
A_VariantType As Integer '(2 bytes) See the VariantTypes Enum, above.
B_Reserved(1 To 6) As Byte '(6 bytes)
C_Data As LongLong '(8 bytes) NOTE: for an array-Variant, its Data is a pointer to the array.
End Type
Type ArrayStruct 'NOTE - the added "X_..." prefixes force the VBE Locals window to display the elements in
'their correct adjacency order:
A_DimCount As Integer '(aka cDim) 2 bytes: The number of dimensions in the array.
B_FeatureFlags As Integer '(aka fFeature) 2 bytes: See the FeatureFlags Enum, below.
C_ElementSize As Long '(aka cbElements) 4 bytes: The size of each element in the array.
D_LockCount As Long '(aka cLocks) 4 bytes: The count of active locks on the array.
E_DataPtr As Long '(aka pvData) 4 bytes: A pointer to the first data element in the array.
F_BoundsInfoArr As LongLong '(aka rgsabound) 8 bytes, min.: An info-array of SA_BoundInfo elements (see below)
' that contains bounds data for each dimension of the safe-array. There is one
' SA_BoundInfo element for each dimension in the array. F_BoundsInfoArr(0) holds
' the information for the right-most dimension and F_BoundsInfoArr[A_DimCount - 1]
' holds the information for the left-most dimension. Each SA_BoundInfo element is
' 8 bytes, structured as follows:
End Type
Function ArrayDims(SomeArray As Variant) As Long 'Cast the array argument to an array-Variant (if it isn't already)
'for a uniform reference-interface to it.
'
'Returns the number of dimensions of the specified array.
'
'AUTHOR: Peter Straton
'
'CREDIT: Adapted from wqw's post at:
' https://stackoverflow.com/questions/67016151/how-to-get-array-dimensionarray-parameter-pass-error
'
'*************************************************************************************************************
Dim DataPtrOffset As Integer
Dim DimCount As Integer '= ArrayStruct.A_DimCount (2 bytes)
Dim VariantType As Integer '= VariantStruct.A_VariantType (2 bytes)
Dim VariantDataPtr As LongLong '= VariantStruct.C_Data (8 bytes). See note about array-Variants' data, above.
'Check the Variant's type
Call CopyMemory(VariantType, SomeArray, LenB(VariantType))
If (VariantType And VTx_Array) Then
'It is an array-type Variant, so get its array data-pointer
Dim VariantX As VariantStruct 'Unfortunately, in VB/VBA, you can't reference the size of a user-defined
'data-Type element without instantiating one.
DataPtrOffset = LenB(VariantX) - LenB(VariantX.C_Data) 'Takes advantage of C_Data being the last element
Call CopyMemory(VariantDataPtr, ByVal VarPtr(SomeArray) + DataPtrOffset, LenB(VariantDataPtr))
If VariantDataPtr <> 0 Then
If (VariantType And VTx_ByRef) Then
'The passed array argument was not an array-Variant, so this function-call's cast to Variant type
'creates an indirect reference to the original array, via the Variant parameter. So de-reference
'that pointer.
Call CopyMemory(VariantDataPtr, ByVal VariantDataPtr, LenB(VariantDataPtr))
End If
If VariantDataPtr <> 0 Then
'Now have a legit Array reference, so get and return its dimension-count value
Call CopyMemory(DimCount, ByVal VariantDataPtr, LenB(DimCount))
End If
End If
End If
ArrayDims = DimCount
End Function 'ArrayDims
Sub Demo_ArrayDims()
'
'Demonstrates the functionality of the ArrayDims function using a 1-D, 2-D and 3-D array of various types
'
'*************************************************************************************************************
Dim Test2DArray As Variant
Dim Test3DArray() As Long
Debug.Print 'Blank line
Debug.Print ArrayDims(Array(20, 30, 400)) 'Test 1D array
Test2DArray = [{0, 0, 0, 0; "Apple", "Fig", "Orange", "Pear"}]
Debug.Print ArrayDims(Test2DArray)
ReDim Test3DArray(1 To 3, 0 To 1, 1 To 4)
Debug.Print ArrayDims(Test3DArray)
End Sub
The SA_BoundInfo Type and FeatureFlags Enum aren't actually used by the ArrayDims routine but they're also included here for reference:
Private Type SA_BoundInfo
ElementCount As Long '(aka cElements) 4 bytes: The number of elements in the dimension.
LBoundVal As Long '(aka lLbound) 4 bytes: The lower bound of the dimension.
End Type
Enum FeatureFlags
FADF_AUTO = &H1 'Array is allocated on the stack.
FADF_STATIC = &H2 'Array is statically allocated.
FADF_EMBEDDED = &H4 'Array is embedded in a structure.
FADF_FIXEDSIZE = &H10 'Array may not be resized or reallocated.
FADF_BSTR = &H100 'An array of BSTRs.
FADF_UNKNOWN = &H200 'An array of IUnknown pointers.
FADF_DISPATCH = &H400 'An array of IDispatch pointers.
FADF_VARIANT = &H800 'An array of VARIANT type elements.
FADF_RESERVED = &HF0E8 'Bits reserved for future use.
End Enum

VBA "Type mismatch: array or user-defined type expected” on String Arrays

I have a dynamic array of strings DMAs which I declare globally.
Dim DMAs() As String
I ReDim the array and assign values to it in the CreateArrayOf function which is of type String() that returns an array of type String()
DMAs = CreateArrayOf(Sites, 2, "", False)
Public Function CreateArrayOf( _
ByRef arrayFrom() As String, _
Optional ByVal numOfChars As Integer = 2, _
Optional ByVal filterChar As String = "", _
Optional ByVal filterCharIsInteger As Boolean = False _
) As String()
Dim i As Integer, _
j As Integer, _
strn As Variant, _
switch As Boolean, _
strArray() As String
'numOfChars 2 for DMA with no filterChar
'numOfChars 3 for W with filterChar "W"
'numOfChars 3 for A with filterChar "A"
'numofChars 2 for D with filterChar "D"
ReDim strArray(LBound(arrayFrom) To LBound(arrayFrom)) 'required in order to
'not throw error on first iteration
For i = LBound(arrayFrom) To UBound(arrayFrom) 'iterate through each site
switch = False
For Each strn In strArray 'iterate through the array to find whether the
'current site already exists
If strn = Mid(arrayFrom(i), 1, numOfChars) And Not strn = "" Then
switch = True
End If
Next strn
If switch = False Then 'if it doesn't exist add it to the array
ReDim Preserve strArray(1 To UBound(strArray) + 1)
strArray(UBound(strArray) - 1) = Mid(arrayFrom(i), 1, numOfChars)
End If
Next i
CreateArrayOf = strArray 'return the new array
End Function
When I attempt to pass the DMAs array to another function OutputAnArray
Private Sub OutputAnArray(ByRef arrayToOutput() As String)
Dim i As Variant
Dim x As Integer
x = 1
For Each i In arrayToOutput
Cells(x, 6).Value = i
x = x + 1
Next i
End Sub
I get the "Type mismatch: array or user-defined type expected". Throughout the whole process I only mess with string arrays.
If I take the content of the OutputAnArray function and put it in the parent function where I'm calling it from, everything's fine.
Any help is appreciated.
I changed all String definitions to Variants
Private Sub OutputAnArray(ByRef arrayToOutput() As Variant)
The culprit was still there, so then after a whole lot of attempts to get this to compile, I removed the () from the arrayToOutput parameter and it started working.
Private Sub OutputAnArray(ByRef arrayToOutput As Variant) 'fixed
What is still perplexing is the fact that in the following function definition, the () are needed for arrayFrom.
Public Function CreateArrayOf(ByRef arrayFrom() As Variant, _ ...
I really don't get it, if anyone has any idea of an explanation, I'd love to hear it.
From the documentation:
"Arrays of any type can't be returned, but a Variant containing an array can."
If follows that the function "CreateArrayOf" does not return an array of strings: it returns a variant containing an array of strings.
The variant cannot be passed as a parameter to a function expecting an array of strings:
Private Sub OutputAnArray(ByRef arrayToOutput() As String)
It can only be passed to a function expecting a variant:
Private Sub OutputAnArray(ByRef arrayToOutput as Variant)
Conversely, DMA is an array of strings:
Dim DMAs() As String
DMA can be passed to a function expecting an array of strings:
Public Function CreateArrayOf(ByRef arrayFrom() As String, _ .
And finally, "Type mismatch: array or user-defined type expected" is a generic type mismatch message. When you pass an array of the wrong type, or a variant array, and get the error "array expected", it's not particularly helpful.
There is no problem with returning typed arrays from functions or passing typed arrays to functions as arguments. The following works as expected:
Option Explicit
Sub asdfasf()
Dim DMAs() As String
DMAs = CreateAnArray()
OutputAnArray DMAs
End Sub
Private Function CreateAnArray() As String()
Dim arr() As String
ReDim arr(1 To 5)
Dim i As Long
For i = LBound(arr) To UBound(arr)
arr(i) = i
Next
CreateAnArray = arr
End Function
Private Sub OutputAnArray(ByRef arrayToOutput() As String)
Dim i As Long
For i = LBound(arrayToOutput) To UBound(arrayToOutput)
Debug.Print arrayToOutput(i)
Next
End Sub
Now, you never show how you actually pass the DMAs array to OutputAnArray.
I'm willing to make an educated guess that you are doing
OutputAnArray (DMAs)
which will indeed result in
Type mismatch: array or user-defined type expected
You cannot freely put parentheses in that manner. They have special meaning.
If you want parentheses to be used when calling a sub, you must use Call:
Call OutputAnArray(DMAs)
And if you don't care, omit the parentheses like in the example above:
OutputAnArray DMAs
I had the same error while passing an array (of user defined type) as an argument to a function ByRef.
In my case the problem was solved using the keyword "Call" in front of the function or the sub being called.
I don't really understand it, but to me it seems like VBA is trying to interpret the function/sub a couple of different ways in the absence of "Call" - which leads to the error message.
I personally try to avoid converting anything to a variant as long as possible.

Passing an unknown number of arguments into ParamArray in VBA

I have a function that takes in a ParamArray that I'm trying to pass an unknown number of parameters into. I'm looping through rows and passing in numbers based on if the cells are empty or not, but it seems like I have to pass in each number as its own argument. I tried putting the numbers into an array and passing that, but it just ended up being an array of an array in the function and not working properly. Is there a way to do this?
Ex:
Dim myarray() as double
Function test(ParamArray arg() as Variant) as Single
'function does stuff with arg(s)
End Function
For Each cell in [somerange]
If cell <> "" then
'save cell value into an myarray?
End If
Next
'want to pass those saved values into function
Call test(myarray)
Edit: I kind of found a workaround. I realized I can pass a range into the function so I'm just going to create a temporary range and pass that in.
From Cpearson Passing And Returning Arrays With Functions, this is how you pass an array into a function and loop that array:
Sub DoSomethingWithPassedArray(ByRef Arr() As Long)
Dim N As Long
For N = LBound(Arr) To UBound(Arr)
'...do something
Next N
End Sub
Further on, it's not clear what you want to do...
Here it is (it is related with my question in Calling vba macro from python with unknown number of arguments)
Use this:
Sub pass_this()
Call flexible("a")
End Sub
Sub pass_alsothis()
Call flexible("a", 2)
End Sub
Sub flexible(ParamArray args() As Variant)
Dim i As Long
MsgBox ("I have received " & _
Str(UBound(args) + 1) & _
" parameters.")
For i = 0 To UBound(args)
MsgBox (TypeName(args(i)))
Next i
End Sub
Cheers.

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

Passing and Receiving an Array from Function

I have made a bunch of 2D arrays in Excel, and I have written a function to put the same data in a copy of each. I'm not quite sure I'm getting the fiddly parts of the syntax correct.
The function is called 'Fill', the old array 'Old' and the new one 'New'. I'm using the name 'Block' for the passing-between variable name.
So, the line in my code is:
New = Fill(Block:=Old())
And the first line of my function is:
Function Fill(Block() As Variant) As Variant
This gives me a type mismatch error of the 'Old' array, saying it is expecting an array. Leads me to think the function is OK, and waiting for the correct type, but not receiving it.
What am I missing?
It has been a while since I did VBA programming, but I would think the following is more likely to be correct:
NewArray = Fill(OldArray)
Function Fill(Block As Variant) As Variant
Fill = Block
End Function
Here are some notes on why you may have got the error you did. If a function expects a particular type, you must declare the variable as that type.
Sub FillThis()
'Declare OldArray as Variant '
'because that is what the function '
'requires. '
Dim OldArray As Variant
'Similarly ...'
Dim StringPart As String
'ByRef, so the variable will be '
'changed by the function. '
'Note that ByRef is the default. '
Fill OldArray
For i = 0 To 4
Debug.Print OldArray(i)
Next
StringPart = "Part 1"
GetString StringPart
Debug.Print StringPart
End Sub
'In this example, Fill is not being returned, '
'so there is no need to declare it as anything '
Function Fill(ByRef OldArray As Variant)
'The Array must be dimensioned '
ReDim OldArray(4)
For i = 0 To 4
OldArray(i) = i + 1
Next
End Function
Function GetString(ByRef StringPart As String)
StringPart = StringPart & " Add a Bit"
End Function