Trouble finding row of element zero of ParamArray - vba

I have an array where in column A different article names are listed. Now I want to add up the values corresponding to some of these article names. Since the number of article names is not constant I am passing the names on as a ParamArray.
All of this works well for elements one to the end of the ParamArray, but an error message "Object variable or with block variable not set" appears when I try to find the row of the article number placed in ParamArray(0). Nevertheless, accessing ParamArray(0) is not a problem, but Vba refuses to find the corresponding row.
Here is the code calling the function (col_ML is the column of the values that are added up):
.Cells(63, col_year).Value = Compute_sum_ML(col_ML, "17.8.32.000", "17.8.42.000")
Here is the function itself:
Function Compute_sum_ML(col_ML As Integer, ParamArray article() As Variant) As Double
Dim row_article As Integer
Dim result As Double
row_article = 0
result = 0
For i = 0 To UBound(article, 1)
row_article = d_ML.Range("A:A").Find(What:=article(i),LookIn:=xlValues).row
If row_article <> 0 Then
result = result + d_ML.Cells(row_article, col_ML).Value
End If
Next i
Compute_sum_ML = result
End Function
Also I tried defining the ParamArray as string since only strings will be passed on to it but it forces me to define it as variant.

The following works for me. I have replaced your sheet code name reference with Worksheets("Sheet1").
Note I have added a test for if a match found.
Option Explicit
Public Sub test()
Debug.Print Compute_sum_ML(2, "17.8.32.000", "17.8.42.000")
End Sub
Public Function Compute_sum_ML(ByVal col_ML As Integer, ParamArray article() As Variant) As Double
Dim row_article As Long, i As Long, result As Double, found As Range
row_article = 0
result = 0
For i = 0 To UBound(article, 1)
Set found = Worksheets("Sheet1").Range("A:A").Find(What:=article(i), LookIn:=xlValues)
If Not found Is Nothing Then
row_article = found.Row
result = result + Worksheets("Sheet1").Cells(row_article, col_ML).Value
'Exit For ''<==If only one match wanted.
End If
Set found = Nothing
Next i
Compute_sum_ML = result
End Function
Data:

Related

VBA Run-time error 450 from function returning a collection

Context: I am writing a function which returns words/numbers present in a string which are enclosed by parenthesis.
Example: Calling ExtractParenthesis("This {should} work. But {doesnt}.") should return a collection containing two items, should and doesnt.
Error: The error I receive from the code below is
Run-time error '450': Wrong number of arguments or invalid property
assignment
It doesn't appear on a particular line and I just receive an error message with "OK" and "Help" as options.
Code:
Public Function ExtractParenthesis(strText As String) As Collection
Dim i As Long
Dim RegExp As Object
Dim Matches As Object
Dim Output As New Collection
Set Output = Nothing
Set RegExp = CreateObject("vbscript.regexp")
RegExp.Pattern = "{(.*?)}"
RegExp.Global = True
Set Matches = RegExp.Execute(strText)
For i = 0 To (Matches.count - 1)
Output.Add Matches(i).submatches(0)
Next i
Set ExtractParenthesis = Output
End Function
It works exactly the way you want it for me:
Option Explicit
Public Sub TestMe()
Dim myColl As New Collection
Set myColl = ExtractParenthesis("This {should} work. But {doesnt}.")
Debug.Print myColl(1)
Debug.Print myColl(2)
End Sub
Public Function ExtractParenthesis(strText As String) As Collection
Dim i As Long
Dim RegExp As Object
Dim Matches As Object
Dim Output As New Collection
Set Output = Nothing
Set RegExp = CreateObject("vbscript.regexp")
RegExp.Pattern = "{(.*?)}"
RegExp.Global = True
Set Matches = RegExp.Execute(strText)
For i = 0 To (Matches.Count - 1)
Output.Add Matches(i).submatches(0)
Next i
Set ExtractParenthesis = Output
End Function
I receive "should" and "doesnt" on the immediate window (Ctrl+G). Probably you are not aware that you are returning a collection. It should be used with the Set keyword.
To run it from the immediate window, try like this:
?ExtractParenthesis("This {should} work. But {doesnt}.")(1)
?ExtractParenthesis("This {should} work. But {doesnt}.")(2)
From what I understand of your comment to Vityatas answer you mean you want to run it as a worksheet function - running it directly
The changes I've made to your code will let you use it as a function:
In A1:B1 this will work: {=ExtractParenthesis("This {should} work. But {doesnt}.")}
In A1:A2 use it like this: {=TRANSPOSE(ExtractParenthesis("This {should} work. But {doesnt}."))}
NB: The curly brackets are added by Excel when you enter the formula using Ctrl+Shift+Enter rather than Enter on its own.
The one problem with the code is that you must select the correct number of cells first - if it should return three words, but you've only selected two then you'll only see the first two.
Public Function ExtractParenthesis(strText As String) As Variant
Dim i As Long
Dim RegExp As Object
Dim Matches As Object
Dim Output As Variant
Set Output = Nothing
Set RegExp = CreateObject("vbscript.regexp")
RegExp.Pattern = "{(.*?)}"
RegExp.Global = True
Set Matches = RegExp.Execute(strText)
ReDim Output(1 To Matches.Count)
For i = 1 To (Matches.Count)
Output(i) = Matches(i - 1).submatches(0)
Next i
ExtractParenthesis = Output
End Function

EXCEL VBA how to use functions and split to extract integer from string

I'm working on a piece of code to extract the nominal size of a pipeline from it's tagname. For example: L-P-50-00XX-0000-000. The 50 would be it's nominal size (2") which I would like to extract. I know I could do it like this:
TagnameArray() = Split("L-P-50-00XX-0000-000", "-")
DNSize = TagnameArray(2)
But I would like it to be a function because it's a small part of my whole macro and I don't need it for all the plants I'm working on just this one. My current code is:
Sub WBDA_XXX()
Dim a As Range, b As Range
Dim TagnameArray() As String
Dim DNMaat As String
Dim DN As String
Set a = Selection
For Each b In a.Rows
IntRow = b.Row
TagnameArray() = Split(Cells(IntRow, 2).Value, "-")
DN = DNMaat(IntRow, TagnameArray())
Cells(IntRow, 3).Value = DN
Next b
End Sub
Function DNMaat(IntRow As Integer, TagnameArray() As String) As Integer
For i = LBound(TagnameArray()) To UBound(TagnameArray())
If IsNumeric(TagnameArray(i)) = True Then
DNMaat = TagnameArray(i)
Exit For
End If
Next i
End Function
However this code gives me a matrix expected error which I don't know how to resolve. I would also like to use the nominal size in further calculations so it will have to be converted to an integer after extracting it from the tagname. Does anyone see where I made a mistake in my code?
This is easy enough to do with a split, and a little help from the 'Like' evaluation.
A bit of background on 'Like' - It will return TRUE or FALSE based on whether an input variable matches a given pattern. In the pattern [A-Z] means it can be any uppercase letter between A and Z, and # means any number.
The code:
' Function declared to return variant strictly for returning a Null string or a Long
Public Function PipeSize(ByVal TagName As String) As Variant
' If TagName doesn't meet the tag formatting requirements, return a null string
If Not TagName Like "[A-Z]-[A-Z]-##-##[A-Z]-####-###" Then
PipeSize = vbNullString
Exit Function
End If
' This will hold our split pipecodes
Dim PipeCodes As Variant
PipeCodes = Split(TagName, "-")
' Return the code in position 2 (Split returns a 0 based array by default)
PipeSize = PipeCodes(2)
End Function
You will want to consider changing the return type of the function depending on your needs. It will return a null string if the input tag doesnt match the pattern, otherwise it returns a long (number). You can change it to return a string if needed, or you can write a second function to interpret the number to it's length.
Here's a refactored version of your code that finds just the first numeric tag. I cleaned up your code a bit, and I think I found the bug as well. You were declaring DNMAAT as a String but also calling it as a Function. This was likely causing your Array expected error.
Here's the code:
' Don't use underscores '_' in names. These hold special value in VBA.
Sub WBDAXXX()
Dim a As Range, b As Range
Dim IntRow As Long
Set a = Selection
For Each b In a.Rows
IntRow = b.Row
' No need to a middleman here. I directly pass the split values
' since the middleman was only used for the function. Same goes for cutting DN.
' Also, be sure to qualify these 'Cells' ranges. Relying on implicit
' Activesheet is dangerous and unpredictable.
Cells(IntRow, 3).value = DNMaat(Split(Cells(IntRow, 2).value, "-"))
Next b
End Sub
' By telling the function to expect a normal variant, we can input any
' value we like. This can be dangerous if you dont anticipate the errors
' caused by Variants. Thus, I check for Arrayness on the first line and
' exit the function if an input value will cause an issue.
Function DNMaat(TagnameArray As Variant) As Long
If Not IsArray(TagnameArray) Then Exit Function
Dim i As Long
For i = LBound(TagnameArray) To UBound(TagnameArray)
If IsNumeric(TagnameArray(i)) = True Then
DNMaat = TagnameArray(i)
Exit Function
End If
Next i
End Function
The error matrix expected is thrown by the compiler because you have defined DNMaat twice: Once as string variable and once as a function. Remove the definition as variable.
Another thing: Your function will return an integer, but you assigning it to a string (and this string is used just to write the result into a cell). Get rid of the variable DN and assign it directly:
Cells(IntRow, 3).Value = DNMaat(IntRow, TagnameArray())
Plus the global advice to use option explicit to enforce definition of all used variables and to define a variable holding a row/column number always as long and not as integer

How can I assign a Variant to a Variant in VBA?

(Warning: Although it might look like one at first glance, this is not a beginner-level question. If you are familiar with the phrase "Let coercion" or you have ever looked into the VBA spec, please keep on reading.)
Let's say I have an expression of type Variant, and I want to assign it to a variable. Sounds easy, right?
Dim v As Variant
v = SomeMethod() ' SomeMethod has return type Variant
Unfortunately, if SomeMethod returns an Object (i.e., a Variant with a VarType of vbObject), Let coercion kicks in and v contains the "Simple data value" of the object. In other words, if SomeMethod returns a reference to a TextBox, v will contain a string.
Obviously, the solution is to use Set:
Dim v As Variant
Set v = SomeMethod()
This, unfortunately, fails if SomeMethod does not return an object, e.g. a string, yielding a Type Mismatch error.
So far, the only solution I have found is:
Dim v As Variant
If IsObject(SomeMethod()) Then
Set v = SomeMethod()
Else
v = SomeMethod()
End If
which has the unfortunate side effect of calling SomeMethod twice.
Is there a solution which does not require calling SomeMethod twice?
In VBA, the only way to assign a Variant to a variable where you don't know if it is an object or a primitive, is by passing it as a parameter.
If you cannot refactor your code so that the v is passed as a parameter to a Sub, Function or Let Property (despite the Let this also works on objects), you could always declare v in module scope and have a dedicated Sub solely for the purpose of save-assigning that variable:
Private v As Variant
Private Sub SetV(ByVal var As Variant)
If IsObject(var) Then
Set v = var
Else
v = var
End If
End Sub
with somewhere else calling SetV SomeMethod().
Not pretty, but it's the only way without calling SomeMethod() twice or touching its inner workings.
Edit
Ok, I mulled over this and I think I found a better solution that comes closer to what you had in mind:
Public Sub LetSet(ByRef variable As Variant, ByVal value As Variant)
If IsObject(value) Then
Set variable = value
Else
variable = value
End If
End Sub
[...] I guess there just is no LetSet v = ... statement in VBA
Now there is: LetSet v, SomeMethod()
You don't have a return value that you need to Let or Set to a variable depending of its type, instead you pass the variable that should hold the return value as first parameter by reference so that the Sub can change its value.
Dim v As Variant
For Each v In Array(SomeMethod())
Exit For 'Needed for v to retain it's value
Next v
'Use v here - v is now holding a value or a reference
You could use error trapping to reduce the expected number of method calls. First try to set. If that succeeds -- no problem. Otherwise, just assign:
Public counter As Long
Function Ambiguous(b As Boolean) As Variant
counter = counter + 1
If b Then
Set Ambiguous = ActiveSheet
Else
Ambiguous = 1
End If
End Function
Sub test()
Dim v As Variant
Dim i As Long, b As Boolean
Randomize
counter = 0
For i = 1 To 100
b = Rnd() < 0.5
On Error Resume Next
Set v = Ambiguous(b)
If Err.Number > 0 Then
Err.Clear
v = Ambiguous(b)
End If
On Error GoTo 0
Next i
Debug.Print counter / 100
End Sub
When I ran the code, the first time I got 1.55, which is less than the 2.00 you would get if you repeated the experiment but with the error-handling approach replaced by the naïve if-then-else approach you discussed in your question.
Note that the more often the function returns an object, the less function calls on average. If it almost always returns an object (e.g. that is what it is supposed to return but returns a string describing an error condition in certain cases) then this way of doing things will approach 1 call per setting/ assigning the variable. On the other hand -- if it almost always returns a primitive value then you will approach 2 calls per assignment -- in which case perhaps you should refactor your code.
It appears that I wasn't the only one with this issue.
The solution was given to me here.
In short:
Public Declare Sub VariantCopy Lib "oleaut32.dll" (ByRef pvargDest As Variant, ByRef pvargSrc As Variant)
Sub Main()
Dim v as Variant
VariantCopy v, SomeMethod()
end sub
It seems this is similar to the LetSet() function described in the answer, but I figured this'd be useful anyway.
Dim v As Variant
Dim a As Variant
a = Array(SomeMethod())
If IsObject(a(0)) Then
Set v = a(0)
Else
v = a(0)
End If

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.

Syntax options creating errors in VBA Macro for Excel

I'm having some trouble with syntax options while writing a VBA Macro for Excel. In VBA you can call a method on an object in two different ways:
foo.bar(arg1, arg2)
or
foo.bar arg1, arg2
I absolutely detest the second sort of syntax because I find it lacks any sort of clarity, so I normally adhere to the first option. However, I've come across a situation where using the first option creates an error, while the second executes fine. (This may perhaps be an indicator of other problems in my code.) Here is the culprit code:
Function GetFundList() As Collection
Dim newFund As FundValues
Range("A5").Select
Set GetFundList = New Collection
While Len(Selection.Value)
Set newFund = New FundValues
' I set the fields of newFund and move Selection
The problem is in this next line:
GetFundList.Add newFund
Wend
End Function
FundValues is a class I created that is essentially just a struct; it has three properties which get set during the loop.
Basically, when I call GetFundList.Add(newFund) I get the following error:
Run-time error '438':
Object doesn't support this property or method
But calling GetFundList.Add newFund is perfectly fine.
Does anyone understand the intricacies of VBA well enough to explain why this is happening?
EDIT: Thanks much for the explanations!
Adding items to a collection is not defined as a function returning a value, but as a sub routine:
Public Sub Add( _
ByVal Item As Object, _
Optional ByVal Key As String, _
Optional ByVal { Before | After } As Object = Nothing _
)
When calling another sub routine by name and sending arguments (without adding the "Call" statement), you are not required to add parentheses.
You need to add parentheses when you call a function that returns a value to a variable.
Example:
Sub Test_1()
Dim iCnt As Integer
Dim iCnt_B As Integer
Dim iResult As Integer
iCnt = 2
iCnt_B = 3
fTest_1 iCnt, iResult, iCnt_B
End Sub
Public Function fTest_1(iCnt, iResult, iCnt_B)
iResult = iCnt * 2 + iCnt_B * 2
End Function
Sub Test_2()
Dim iCnt As Integer
Dim iCnt_B As Integer
Dim iResult As Integer
iCnt = 2
iCnt_B = 3
iResult = fTest_2(iCnt, iCnt_B)
End Sub
Public Function fTest_2(iCnt, iCnt_B)
fTest_2 = iCnt * 2 + iCnt_B * 2
End Function
Let me know if not clear.
This Daily Dose of Excel conversation will be helpful.
When you use the parentheses you are forcing VBA to evaluate what's inside them and adding the result to the collection. Since NewFund has no default property - I assume - the evaluation yields nothing, so can't be added. Without the parentheses it evaluates to the instance of the class, which is what you want.
Another example. This:
Dim coll As Collection
Set coll = New Collection
coll.Add Range("A1")
Debug.Print coll(1); TypeName(coll(1))
and this ...
coll.Add (Range("A1"))
Debug.Print coll(1); TypeName(coll(1))
... both yield whatever is in A1 in the debug.window, because Value is Range's default property. However, the first will yield a type of "Range", whereas the type in the 2nd example is the data type in A1. In other words, the first adds a range to the collection, the 2nd the contents of the range.
On the other hand, this works:
Dim coll As Collection
Set coll = New Collection
coll.Add ActiveSheet
Debug.Print coll(1).Name
... and this doesn't:
coll.Add (ActiveSheet)
Debug.Print coll(1).Name
because ActiveSheet has no default property. You'll get an runtime error 438, just like in your question.
Here's another way of looking at the same thing.
Let assume that cell A1 contains the string Hi!
Function SomeFunc(item1, item2)
SomeFunc = 4
End Function
Sub Mac()
' here in both of the following two lines of code,
' item1 will be Variant/Object/Range, while item2 will be Variant/String:
SomeFunc Range("A1"), (Range("A1"))
Let i = SomeFunc(Range("A1"), (Range("A1")))
'this following is a compile syntax error
SomeFunc(Range("A1"), (Range("A1")))
' while here in both the following two lines of code,
' item1 will be Variant/String while item2 will be Variant/Object/Range:
SomeFunc ((Range("A1")), Range("A1")
Let j = SomeFunc((Range("A1")), Range("A1"))
'this following is a compile syntax error
SomeFunc((Range("A1")), Range("A1"))
Set r = Range("A1") ' sets r to Variant/Object/Range
Set r = (Range("A1")) ' runtime error 13, type mismatch; cannot SET r (as reference) to string "Hi!" -- Strings are not objects in VBA
Set r = Range("A1").Value ' runtime error (same)
Let r = Range("A1") ' set r to "Hi!" e.g. contents of A1 aka Range("A1").Value; conversion to value during let = assignment
Let r = (Range("A1")) ' set r to "Hi!" e.g. contents of A1 aka Range("A1").Value; conversion to value by extra ()'s
Let r = Range("A1").Value ' set r to "Hi!" by explicit use of .Value
End Sub
I only add this to help illustrate that there are two things going on here, which could be conflated.
The first is that the () in an expression that converts the item to its Value property as stated above in other answers.
The second is that functions invoked with intent to capture or use the return value require extra () surrounding the whole argument list, whereas functions (or sub's) invoked without intent to capture or use the return value (e.g. as statements) must be called without those same () surrounding the argument list. These surrounding () do not convert the argument list using .Value. When the argument list has only one parameter, this distinction can be particularly confusing.