If my function looks like
function(optional byval string1 as String,optional byval string2 as String,optional byval string3 as String )
And I only want to call the function by supplying string3 by entering "=function(string3)" in cell, how can I do that ?
It's possible in one of two ways...
Call the routine and identify which optional parameter is being used by "skipping" unusued parms:
Function MyFunc(optional a as integer, _
optional b as integer, _
optional c as integer) as double
MyFunc = c * 3.14159
End Function
=MyFunc(,,12) <== called as UDF on worksheet or in VBA module
Code your function with an argument list:
Function MyFunc(args() As Variant) As Double
Dim numberOfArgs As Integer
Dim arg As Variant
Dim i As Integer
Dim answer As Double
numberOfArgs = UBound(args)
i = 1
For Each arg In args
Debug.Print "arg(" & i & ") = " & arg
answer = Int(arg) * 3.14159
i = i + 1
Next arg
MyFunc = answer
End Function
Sub test1()
Dim parms() As Variant
ReDim parms(1 To 3)
'parms(1) = ??
'parms(2) = ??
parms(3) = 21
Debug.Print MyFunc(parms)
End Sub
Related
I trying to create an empty/defined array of Double which would reflect as Double(0, -1).
I'm able to create one for an array of String, Variant and Byte:
Dim arr_variant() As Variant
arr_variant = Array() ' Variant(0 to -1) '
Dim arr_string() As String
arr_string = Split(Empty) ' String(0 to -1) '
Dim arr_byte() As Byte
arr_byte = "" ' Byte(0 to -1) '
Dim arr_double() As Double
arr_double = ??? ' Double(0 to -1) '
, but still haven't found a way for Double.
Maybe with LSet or with a native function?
It seems that the only way is to call a native function:
Private Declare PtrSafe Function SafeArrayRedim Lib "OleAut32" ( _
ByVal arr As LongPtr, ByRef dims As Any) As Long
Public Sub RedimDouble(arr() As Double, ByVal count As Long)
If count Then
ReDim Preserve arr(0 To count - 1)
Else
ReDim arr(0 To 0)
SafeArrayRedim Not Not arr, 0#
End If
End Sub
Public Sub Usage()
Dim arr_double() As Double
RedimDouble arr_double, 0 ' Double(0 to -1) '
End Sub
I would go with - not possible.
Take a look at the following code:
Option Explicit
Sub TestMe()
Dim arr 'Line 1
arr = Array(CDbl(0)) 'Line 2
arr = Array(Empty) 'Line 3
End Sub
Line 1 - It takes a Variant array
Line 2 - Makes it Double array
Line 3 - When emptied, it is converted from double to Variant again.
This question already has an answer here:
Range.Cells property syntax
(1 answer)
Closed 5 years ago.
I have been trying to write functions to automate some of my routine calculations. However there are the following problems I came across:
SumbyCode1 function always works in the sheet that contains the data. However, it doesn't work in other worksheets of the same workbook.
CountbyCode function doesn't work. I tried the function as an ordinary sub, and it works perfectly there. However, then I apply the codes in function. It doesn't work at all.
See codes below:
Public Function SumbyCode1(ByRef wirecode0, Optional ByRef wirecode1, _
Optional ByRef wirecode2, Optional ByRef wirecode3, _
Optional ByRef wirecode4, Optional ByRef wirecode5, _
Optional ByRef wirecode6, Optional ByRef wirecode7, _
Optional ByRef wirecode8)
Dim var()
var = Array(wirecode0, wirecode1, wirecode2, wirecode3, wirecode4, _
wirecode5, wirecode6, wirecode7, wirecode8)
Dim ws As Worksheet
Set ws = Worksheets("Banking Transaction")
Dim colnumbercode As Integer
Dim colnumberamount As Integer
Dim total As Variant
total = 0
With ws
colnumbercode = Application.WorksheetFunction.Match("Type", Range("1:1"), 0)
colnumbercodeletter = Chr(64 + colnumbercode)
codecol = colnumbercodeletter & ":" & colnumbercodeletter
colnumberamount = Application.WorksheetFunction.Match("Amount", Range("1:1"), 0)
colnumberamountletter = Chr(64 + colnumberamount)
codeamount = colnumberamountletter & ":" & colnumberamountletter
For i = 0 To 8
total = Application.WorksheetFunction.SumIf(Range(codecol), _
var(i), Range(codeamount)) + total
Next i
End With
SumbyCode1 = total
End Function
Public Function CountbyCode(ByRef wirecode0, Optional ByRef wirecode1, _
Optional ByRef wirecode2, Optional ByRef wirecode3, _
Optional ByRef wirecode4, Optional ByRef wirecode5, _
Optional ByRef wirecode6, Optional ByRef wirecode7, _
Optional ByRef wirecode8)
Dim var()
var = Array(wirecode0, wirecode1, wirecode2, wirecode3, _
wirecode4, wirecode5, wirecode6, wirecode7, wirecode8)
Dim ws As Worksheet
Set ws = Worksheets("Banking Transaction")
Dim colnumbercode As Integer
Dim total As Variant
total = 0
With ws
colnumbercode = Application.WorksheetFunction.Match("Type", Range("1:1"), 0)
colnumbercodeletter = Chr(64 + colnumbercode)
codecol = colnumbercodeletter & ":" & colnumbercodeletter
For i = 0 To 8
total = Application.WorksheetFunction.CountIf(Range(codecol), _
var(i)) + total
Next i
End With
CountbyCode = total
End Function
You need to fully qualify your references. When you use:
total = Application.WorksheetFunction.CountIf(Range(codecol), var(i)) + total
The VB Editor silently interprets Range(codecol) as ThisWorkbook.ActiveSheet.Range(codecol), which means the function only works on the currently active sheet. As #ScottCraner suggested, you need to change that to a fully explicit reference using your previous With ws declaration by changing Range(codecol) to .Range(codecol).
I get a compile error at the last line when testing the following: (Only public user defined types that are defined in a public object module can be coerced to or from a variant or passed to late-bound functions.)
Option Explicit
Public Type aType
P_Col As Integer
P_Rad As Single
P_X As Single
P_Y As Single
End Type
Function MakePatterns() As Variant
Dim i As Integer
Dim circles() As aType
For i = 1 To 5
ReDim Preserve circles(i)
circles(i).P_Col = Int(i / 2)
circles(i).P_Rad = i
circles(i).P_X = i * 10 + 1
circles(i).P_Y = i * 10 + 5
Next
For i = 1 To 5
Debug.Print circles(i).P_Col; circles(i).P_Rad; _
circles(i).P_X; circles(i).P_Y
Next
MakePatterns = circles
End Function
Is there a way to use TYPE and Function together to return an array? Or is there a more effective way?
In the code below Sub "TestCallFunction" calls the Function "MakePatterns", and after it prints the first array received back from the function in the Immediate window.
Option Explicit
Public Type aType
P_Col As Integer
P_Rad As Single
P_X As Single
P_Y As Single
End Type
Sub TestCallFunction()
Dim x() As aType
Dim i As Integer
x = MakePatterns
' print the first result received from Function MakePatterns
Debug.Print x(1).P_Col & ";" & x(1).P_Rad & ";" & x(1).P_X & ";" & x(1).P_Y
End Sub
Public Function MakePatterns() As aType()
Dim i As Integer
Dim circles() As aType
For i = 1 To 5
ReDim Preserve circles(i)
circles(i).P_Col = Int(i / 2)
circles(i).P_Rad = i
circles(i).P_X = i * 10 + 1
circles(i).P_Y = i * 10 + 5
Next
For i = 1 To 5
Debug.Print circles(i).P_Col; circles(i).P_Rad; _
circles(i).P_X; circles(i).P_Y
Next
MakePatterns = circles
End Function
I am calling a specific piece of code several times therefore I would like to use optional parameters.
I can write something like:
Public Sub main()
strA = "A"
'Calling the function
CalculateMe (strA)
End Sub
Public Sub CalculateMe(strA As String)
Set rs = DB.OpenRecordset("tbl_A")
rs.MoveFirst
Do Until rs.EOF
If rs.Fields(0) = strA Then
dblA = rs.fields(2).Value
End If
rs.MoveNext
Loop
End Sub
How can I change the function to hold more than 1 optional parameters?
Something like:
Public Sub main()
strA = "A"
strB = "B"
'Calling the function
CalculateMe (strA, strB)
more code
End Sub
Public Sub CalculateMe(Optional strA As String, Optional strB as String)
Set rs = DB.OpenRecordset("tbl_A")
rs.MoveFirst
Do Until rs.EOF
If rs.Fields(0).Value = strA And rs.Fields(1).Value = strB Then
dblA = rs.Fields(2).Value
End If
rs.MoveNext
Loop
End Sub
Following Pankaj Jaju's advice, I have managed to have it run by changing it to:
Public Sub main()
strA = "A"
strB = "B"
'Calling the function
dblA = CalculateMe (strA, strB)
End Sub
Public Function CalculateMe(Optional ByVal strA As String, Optional ByVal strB as String)
Set rs = DB.OpenRecordset("tbl_A")
rs.MoveFirst
Do Until rs.EOF
If rs.Fields(0).Value = strA And rs.Fields(1).Value = strB Then
dblA = rs.Fields(2).Value
End If
rs.MoveNext
Loop
End Sub
Now, how can I clear the value of an optional parameter? I will need this for some of the calculations. Something like:
Set strA = Nothing
Change your sub and add ByVal
Public Sub CalculateMe(Optional ByVal strA As String, Optional ByVal strB As String)
Public Sub CalculateMe(Optional varA As Variant, Optional varB as Variant)
Excerpts from Chip Pearson's excellent explanation:
Rules governing the use of optional parameters:
The Optional keyword must be present to make a parameter optional.
The data type should be (but need not be, see below) a Variant data
type.
The optional parameter(s) must be at the end of the parameter
list.
The IsMissing function will work only with parameters declared
as Variant. It will return False when used with any other data type.
User defined types (UTDs) cannot be optional parameters.
Example
Function Test(L1 As Long, L2 As Long, _
Optional P1 As Variant, Optional P2 As Variant) As String
Dim S As String
If IsMissing(P1) = True Then
S = "P1 Is Missing."
Else
S = "P1 Is Present (P1 = " & CStr(P1) & ")"
End If
If IsMissing(P2) = True Then
S = S & " " & "P2 Is Missing"
Else
S = S & " " & "P2 Is Present (P2 = " & CStr(P2) & ")"
End If
Test = S
End Function
Here, both L1 and L2 are required but P1 and P2 are optional. Since both are Variant types, we can use IsMissing to determine whether the parameter was passed in. IsMissing returns True if the Variant parameter is omitted, or False if the Variant parameter is included. If the data type of the optional parameter is any data type other than Variant, IsMissing will return False.
Instead of CalculateMe(,strB) you can use
dblA = CalculateMe strB:="B"
I'm not sure you really mean "optional". In your example, you're listing the args as optional, but you're still passing both arguments to the function.
In any case, here you pass both arguments:
Public Sub main()
strA = "A"
strB = "B"
'Calling the function
dblA = CalculateMe(strA, strB)
more code
End Sub
If you want to pass only one of the arguments, then do like:
dblA = CalculateMe(, strB)
Or:
dblA = CalculateMe(strA)
Otherwise, if you are always passing both arguments, then it doesn't make sense to have them Optional.
I have string "ololo123".
I need get position of first digit - 1.
How to set mask of search ?
Here is a lightweight and fast method that avoids regex/reference additions, thus helping with overhead and transportability should that be an advantage.
Public Function GetNumLoc(xValue As String) As Integer
For GetNumLoc = 1 To Len(xValue)
If Mid(xValue, GetNumLoc, 1) Like "#" Then Exit Function
Next
GetNumLoc = 0
End Function
Something like this should do the trick for you:
Public Function GetPositionOfFirstNumericCharacter(ByVal s As String) As Integer
For i = 1 To Len(s)
Dim currentCharacter As String
currentCharacter = Mid(s, i, 1)
If IsNumeric(currentCharacter) = True Then
GetPositionOfFirstNumericCharacter = i
Exit Function
End If
Next i
End Function
You can then call it like this:
Dim iPosition as Integer
iPosition = GetPositionOfFirstNumericCharacter("ololo123")
Not sure on your environment, but this worked in Excel 2010
'Added reference for Microsoft VBScript Regular Expressions 5.5
Const myString As String = "ololo123"
Dim regex As New RegExp
Dim regmatch As MatchCollection
regex.Pattern = "\d"
Set regmatch = regex.Execute(myString)
MsgBox (regmatch.Item(0).FirstIndex) ' Outputs 5
I actually have that function:
Public Function GetNumericPosition(ByVal s As String) As Integer
Dim result As Integer
Dim i As Integer
Dim ii As Integer
result = -1
ii = Len(s)
For i = 1 To ii
If IsNumeric(Mid$(s, i, 1)) Then
result = i
Exit For
End If
Next
GetNumericPosition = result
End Function
You could try regex, and then you'd have two problems. My VBAfu is not up to snuff, but I'll give it a go:
Function FirstDigit(strData As String) As Integer
Dim RE As Object REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Pattern = "[0-9]"
End With
Set REMatches = RE.Execute(strData)
FirstDigit = REMatches(0).FirstIndex
End Function
Then you just call it with FirstDigit("ololo123").
If speed is an issue, this will run a bit faster than Robs (noi Rob):
Public Sub Example()
Const myString As String = "ololo123"
Dim position As Long
position = GetFirstNumeric(myString)
If position > 0 Then
MsgBox "Found numeric at postion " & position & "."
Else
MsgBox "Numeric not found."
End If
End Sub
Public Function GetFirstNumeric(ByVal value As String) As Long
Dim i As Long
Dim bytValue() As Byte
Dim lngRtnVal As Long
bytValue = value
For i = 0 To UBound(bytValue) Step 2
Select Case bytValue(i)
Case vbKey0 To vbKey9
If bytValue(i + 1) = 0 Then
lngRtnVal = (i \ 2) + 1
Exit For
End If
End Select
Next
GetFirstNumeric = lngRtnVal
End Function
An improved version of spere's answer (can't edit his answer), which works for any pattern
Private Function GetNumLoc(textValue As String, pattern As String) As Integer
For GetNumLoc = 1 To (Len(textValue) - Len(pattern) + 1)
If Mid(textValue, GetNumLoc, Len(pattern)) Like pattern Then Exit Function
Next
GetNumLoc = 0
End Function
To get the pattern value you can use this:
Private Function GetTextByPattern(textValue As String, pattern As String) As String
Dim NumLoc As Integer
For NumLoc = 1 To (Len(textValue) - Len(pattern) + 1)
If Mid(textValue, NumLoc, Len(pattern)) Like pattern Then
GetTextByPattern = Mid(textValue, NumLoc, Len(pattern))
Exit Function
End If
Next
GetTextByPattern = ""
End Function
Example use:
dim bill as String
bill = "BILLNUMBER 2202/1132/1 PT2200136"
Debug.Print GetNumLoc(bill , "PT#######")
'Printed result:
'24
Debug.Print GetTextByPattern(bill , "PT#######")
'Printed result:
'PT2200136