Passing an unknown number of arguments into ParamArray in VBA - 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.

Related

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

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

Variant array is 'corrupted' when running macro - Excel crashes

I have a macro (code attached) which writes the data from two sheets into two variant arrays. It then uses a nested loop to look for all possible matches in the 2nd sheet on a piece of data in the 1st sheet.
When the first match is found one of the variant arrays appears to get wiped and I get a 'Subscript out of range'. this can happen when the data is being compared or when I subsequently try to pass data from that array to another procedure as a result of a match being found.
When I look in the Locals window, this array can change from showing the stored values to having the error message "Application-defined or object-defined error" in each index, or no indexes at all, or indexes with high negative numbers.
Regardless, if I try to investigate further while the code is in debug mode, Excel crashes ("Excel has encountered a problem and needs to close").
I have followed the advice at this link:
http://exceleratorbi.com.au/excel-keeps-crashing-check-your-vba-code/
...but to no avail.
I've stepped through the code and can trace it to the first time the data values being tested match. It happens for the same indexes (same i and j values) every time I run.
I'm using Excel 2013 on our office network.
Can anyone tell me what might be causing this or any tests I could perform to help narrow down the cause?
Could it be due to memory use? The arrays come out at about 15000 x 11 and 4000 x 6 and it's the smaller one that is being corrupted/failing.
Sub classTest()
Dim i As Long, j As Long
Dim CK_Array() As Variant, RL_Array() As Variant
Dim wb As Workbook
Dim CK_Data As Worksheet, RL_Data As Worksheet
Set wb = ThisWorkbook
Set CK_Data = wb.Sheets(1)
Set RL_Data = wb.Sheets(2)
Call getRange_BuildArray(CK_Array, CK_Data)
Call getRange_BuildArray(RL_Array, RL_Data) ' this sets the array that gets corrupted.
For i = 2 To UBound(CK_Array)
If Not IsEmpty(CK_Array(i, 6)) Then
For j = 2 To UBound(RL_Array)
If CK_Array(i, 6) = RL_Array(j, 4) Then ' array gets corrupted here or line below
Call matchFound(dResults, CStr(CK_Array(i, 1) & " | " & CK_Array(i, 5)), CStr(RL_Array(j, 2) & " " & RL_Array(j, 3)), CStr(RL_Array(j, 1)), CStr(RL_Array(1, 3))) ' or array gets corrupted here
End If
Next j
End If
Next i
End Sub
Private Sub getRange_BuildArray(arr As Variant, ws As Worksheet)
Dim endR As Long, endC As Long
Dim rng As Range
endR = ws.UsedRange.Rows.Count
endC = ws.UsedRange.Columns.Count
Set rng = Range(ws.Cells(1, 1), ws.Cells(endR, endC))
arr = rng
End Sub
EDIT:
As requested here is the code to the matchfound Sub. It's a dictionary, which holds class objects in a collection. Therefore I have also posted the class code below. I'm not yet making use of all of the class properties and methods as this issue has halted my testing.
Sub matchFound(dictionary As Object, nameCK As String, nameRL As String, RLID As String, dataitem As String)
Dim cPeople As Collection
Dim matchResult As CmatchPerson
If dictionary.exists(nameCK) Then
Set matchResult = New CmatchPerson
matchResult.Name = nameRL
matchResult.RLID = RLID
matchResult.matchedOn = dataitem
dictionary.Item(nameCK).Add matchResult
Else
Set cPeople = New Collection
Set matchResult = New CmatchPerson
matchResult.Name = nameRL
matchResult.RLID = RLID
matchResult.matchedOn = dataitem
cPeople.Add matchResult
dictionary.Add nameCK, cPeople
End If
End Sub
Class
Option Explicit
Private pName As String
Private pRLID As String
Private pMatchedOn As String
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(Name As String)
pName = Name
End Property
Public Property Get RLID() As String
RLID = pRLID
End Property
Public Property Let RLID(ID As String)
pRLID = ID
End Property
Public Property Get matchedOn() As String
matchedOn = pMatchedOn
End Property
Public Property Let matchedOn(textString As String)
pMatchedOn = textString
End Property
Public Sub MatchedOnString(datafield As String)
Dim text As String
text = Me.matchedOn & "|" & datafield
Me.Name = text
End Sub
I've reduced your problem to a Minimum, Verifiable and Complete Example.
The problem occurs when you assign the implicit default value of a range to a Variant variable that was passed as a Variant array.
Sub VariantArrayWTF()
Dim aBar() As Variant
Dim aFoo() As Variant
GetArray aBar
GetArray aFoo
Debug.Print aBar(1, 1)
'aFoo() has now lost it's `+` sign in Locals window, but the bounds are still visible
Debug.Print aBar(1, 1)
'aFoo() has now lost its bounds in Locals Window
'aFoo(1,1) will produce subscript out of range
'Exploring the Locals Window, incpsecting variables, will crash Excel
Debug.Print aFoo(1, 1)
End Sub
Sub GetArray(ByRef theArray As Variant)
'Note the use of theArray instead of theArray()
'Implicitly calling the default member is problematic
theArray = Sheet1.UsedRange
End Sub
There are a number of workarounds - I'd recommend using both:
Use Explicit calls to `Range.Value`
You can even make explicit call to the default member Range.[_Default]. The exact method isn't important, but it must be explicit.
Sub GetArray(ByRef theArray As Variant)
theArray = Sheet1.UsedRange.Value
End Sub
Avoid the use of `Call`, and pass common Variant definitions
Call is a deprecated statement, and can be omitted.
Declare the arrays and the helper functions' array argument consistently. That is, use () in all instances, or none.
Note the difference between declaring Dim aFoo() As Variant which is an array of Variants, and declaring Dim aFoo As Variant which is a Variant that can contain an array.
With Parentheses
Sub VariantArrayWTF()
Dim aBar() As Variant
Dim aFoo() As Variant
GetArray aBar
GetArray aFoo
Debug.Print aBar(1, 1)
Debug.Print aBar(1, 1)
Debug.Print aFoo(1, 1)
End Sub
Sub GetArray(ByRef theArray() As Variant)
theArray = Sheet1.UsedRange
End Sub
Without Parentheses
Sub VariantArrayWTF()
Dim aBar As Variant
Dim aFoo As Variant
GetArray aBar
GetArray aFoo
Debug.Print aBar(1, 1)
Debug.Print aBar(1, 1)
Debug.Print aFoo(1, 1)
End Sub
Sub GetArray(ByRef theArray As Variant)
theArray = Sheet1.UsedRange
End Sub
I have found the lines of code which were causing the problem. However, I cannot explain why it would necessarily cause a crash so I would appreciate other input on why this is happening.
When passing the RL and CK arrays to the getRange_Build Array sub I left out the brackets that would have denoted these variables as arrays.
The code was this...
Call getRange_BuildArray(CK_Array, CK_Data)
Call getRange_BuildArray(RL_Array, RL_Data)
...but should have been this
Call getRange_BuildArray(CK_Array(), CK_Data)
Call getRange_BuildArray(RL_Array(), RL_Data)
I'm thinking the reason that this didn't get flagged as a compile error is because the parameter in question in the getRange_BuildArray procedure itself also lacked the necessary brackets to denote an array.
It was this...
Private Sub getRange_BuildArray(arr As Variant, ws As Worksheet)
...it should have been this
Private Sub getRange_BuildArray(arr() As Variant, ws As Worksheet)
With those changes in place the macro is completing successfully for the full dataset and is not causing excel to crash.
As mentioned it would be great if someone could offer a more detailed breakdown of how this caused excel to crash.

Create function but only for use in VBA environment (not in workbook formulas)

This is new to me - I've created a function that I use for updating a SQL Server table via VBA. It takes in a range of cells and it returns a Long of how many records were affected.
So, I would like this function to be available throughout my workbooks for use within VBA, but don't want it to show up as an available formula in Excel (outside of the VBA environment).
I'm sure I've done this before, but can't remember how to hide my Function from Excel so it's only for use in VBA.
How can I do this?
Move it into its own module (.bas), and stick Option Private Module at the top. Done; Excel won't see it anymore, but VBA will (and COM add-ins can see it too, so I figure a referencing VBA project could see it as well).
I would just use a sub and pass the parameters ByRef. With an integer/long variable, you can accomplish this a few different ways:
See examples:
Sub Main()
Dim i as Long
i = 1
bar (i) 'Variable is passed ByVal because parens FORCE an evaluation, you aren't passing "i", you're passing the expression "(i)".
Debug.Print i
bar i 'Variable is passed ByRef even without explicitly doing so
Debug.Print i
anotherFunction i 'Variable is passed ByRef, same as above
Debug.Print "i: " & CStr(i)
anotherFunction (i) 'Variable is passed ByVal because parens FORCE an evaluation
Call anotherFunction(i) 'Variable is passed byRef
End Sub
Sub bar(val As Long)
Dim j
For j = 1 To 10
val = val + 1
Debug.Print "j: " & CStr(val)
Next
End Sub
Sub anotherFunction(ByRef val as Long)
Dim j
For j = 1 To 10
val = val + 1
Debug.Print "j: " & CStr(val)
Next
End Sub

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