Is there any reason one would write VBA.Replace(), VBA.Instr() instead of just Replace(), Instr() when using these standard functions in VBA?
The only reason I can think of is when you declared functions with the same name in a custom module and you want to differentiate between them.
Edit: This example is answered, thanks to the link provided below (in short Len() is a keyword, not just a function). The example was bad since Len() is an exception.
Debug.Print VBA.Len(10) returns "2" while
Debug.Print Len(10) throws an error.
The original question remains, is there any caveat of not using the VBA. every time?
You basically answered your own question: If you create a public method with the same name as a VBA method, it takes precedence over the VBA one. E.g. put this one in a module:
'------------------------------------------------------------------------------
'Purpose : Override the VBA.CreateObject function in order to register what object
' is being created in any error message that's generated.
'
' Author: Darin Higgins
' Source: http://www.darinhiggins.com/the-vb6-createobject-function/
'------------------------------------------------------------------------------
Public Function CreateObject(ByVal sClass As String, _
Optional ByVal sServerName As String = vbNullString _
) As Object
Dim sSource As String, sDescr As String, lErrNum As Long
On Error Resume Next
If Len(sServerName) Then
Set CreateObject = VBA.CreateObject(sClass, sServerName)
Else
Set CreateObject = VBA.CreateObject(sClass)
End If
If VBA.Err Then
sSource = VBA.Err.Source
sDescr = VBA.Err.Description
lErrNum = VBA.Err
sDescr = sDescr & " (ProgID: " & sClass
If Len(sServerName) Then
sDescr = sDescr & ". Instantiated on Server '" & sServerName & "'"
End If
sDescr = sDescr & ")"
On Error GoTo 0
VBA.Err.Raise lErrNum, sSource, sDescr
End If
On Error GoTo 0
End Function
Steping through the code Set x = CreateObject("Object.Class") will step into this function instead of VBA.CreateObject.
Related
I've stumbled upon a compile error, but don't get what can be of the issue. When trying to chagne the symbol to an input variable ( TickerID ) I get the error, works perfectly fine otherwise when inputting e.g "yhoo" for the yahoo ticker name.
Code
Private Sub CmdBtn_Add_Click()
'---------------------------------------------------------------------------------------'
' Checks that inputted ticker name is correct and calls import class after confirmation
'---------------------------------------------------------------------------------------'
' General Variables---------'
Dim TickerID As String: TickerID = UCase(Add_Instrument.TxtBox_Instrument.Value)
'--------------------------'
'Check if input field is not empty
If TickerID = "" Or Application.WorksheetFunction.IsText(TickerID) = False Then
MsgBox "Please provide a valid ticker ID"
Exit Sub
End If
Debug.Print TickerID
'Check Ticker name exists through YQLBuilder class
Dim YQLBuilder As YQLBuilder: Set YQLBuilder = New YQLBuilder
Call YQLBuilder.TickerCheck(TickerID)
' Call ImportData(TickerID)
' MsgBox "Please check the ticker name. It is in the wrong format"
End Sub
Public Sub TickerCheck(TickerID As String)
'---------------------------------------------------------------------------------------'
' Built 2014-11-05 Allows parsing of XML data through YAHOO API YQL
' 2014-12-21: Not fully built yet, see where it can be of use
'---------------------------------------------------------------------------------------'
' General Variables---------'
Const ConnStringStart As String = "http://query.yahooapis.com/v1/public/yql?q="
Const ConnStringLast As String = "&diagnostics=true&env=store://datatables.org/alltableswithkeys"
'---------------------------'
Const ConnStringInput As String = "select * from yahoo.finance.stocks where symbol='" _
& TickerID & "'" **<----- Error here!**
Debug.Print ConnStringStart & ConnStringInput & ConnStringLast
Dim YQLNodes As MSXML2.IXMLDOMNodeList
Dim YQLReq As MSXML2.DOMDocument60
Set YQLReq = New MSXML2.DOMDocument60
YQLReq.async = False
YQLReq.Load ConnStringStart & ConnStringInput & ConnStringLast
YQLReq.setProperty "SelectionNamespaces", "xmlns:f='http://www.yahooapis.com/v1/base.rng'"
Set YQLNodes = YQLReq.SelectNodes("//CompanyName")
Dim xNode As MSXML2.IXMLDOMNode
For Each xNode In YQLNodes
Debug.Print xNode.Text
Next xNode
Debug.Print YQLNodes.Length
End Sub
The message is clear. When you declare a constant, the value you give it must be constant too. In this case, part of it is the parameter TickerId, which is variable. You cannot declare a constant with a variable value.
To solve this, I think you could just use Dim instead of Const and not make ConnStringInput a constant at all.
Using Excel VBA: Is it possibile to get the text contained in the tooltip which shows the argument list of a sub or function?
The Application.MacroOptions method knows the argument "ArgumentDescriptions" but it is possibly only set. Is there any way to read this info?
"Get the tooltip text contained showing the argument list of a sub or function ... The Application.MacroOptions Method has (the) argument ArgumentDescriptions but it Is possibile(!) only set. Is there any way to read this info?"
► Afaik there is no built-in way.
Possible workaround
As you "need this info in VBA code for a function/sub created in other module or class.",
you might want to analyze your code modules by referencing the
"Microsoft Visual Basic for Applications Extensibility 5.3" library in the VB Editor's menu.
Caveats:
Security: Requires to trust access to the VBA project object model.
Rights: If not only for your personal use, consider that other corporate users may
not have enough rights to turn that feature on.
Self reflection: Mirrors the currently compiled/saved code only, so it might not reflect the latest code when the searched procedure body line has been changed.
Line breaks: The following approach assumes that the entire procedure info is coded in one line -
not regarding closing line breaks via "_";
it should be easy to extend the .Lines result in these cases by your own (e.g. benefitting from the count argument or by additional loops through the next lines).
The following code doesn't intend neither to cover or to optimize all possibilities,
but to direct you to a solution keeping it short & simple.
Function GetSyntax()
Function GetSyntax(wb As Workbook, Optional ByVal srchProcName As String = "GetCookie") As String
'Purp: Show name & arguments of a given procedure
'1) escape a locked project
If wb.VBProject.Protection = vbext_pp_locked Then Exit Function ' escape locked projects
'2) loop through all modules
Dim component As VBIDE.VBComponent
For Each component In wb.VBProject.VBComponents
' Debug.Print "***"; component.Name, component.Type
Dim found As Boolean
'3) loop through procedures (as well as Let/Set/Get properties)
Dim pk As Long ' proc kind enumeration
For pk = vbext_pk_Proc To vbext_pk_Get
'a) get the essential body line of the search procedure
Dim lin As String
lin = getLine(component.CodeModule, srchProcName, pk)
'b) found non-empty code line?
found = Len(lin) <> 0
If found And pk = 0 Then GetArgs = lin: Exit For
'c) get proc info(s) - in case of Let/Set/Get properties
Dim Delim As String
GetSyntax = GetSyntax & IIf(found, Delim & lin, "")
Delim = vbNewLine ' don't change line order
Next pk
'If found Then Exit For ' if unique proc names only
Next component
End Function
Help function getLine()
Function getLine(module As VBIDE.CodeModule, ByVal srchProcName As String, ByVal pk As Long) As String
'a) define procedure kind
Dim ProcKind As VBIDE.vbext_ProcKind
ProcKind = pk
'b) get effective row number of proc/prop body line
On Error Resume Next
Dim effectiveRow As Long
effectiveRow = module.ProcBodyLine(srchProcName, ProcKind) ' find effective row of search procedure
'c) provide for non-findings or return function result (Case 0)
Select Case Err.Number
Case 0 ' Found
Dim lin As String
'Syntax: obj.Lines (startline, count) As String
lin = Trim(module.Lines(effectiveRow, 1))
getLine = lin
Case 35 ' Not found
Err.Clear: On Error GoTo 0
Case Else
Debug.Print "** " & " Error " & Err.Number & " " & Err.Description: Err.Clear: On Error GoTo 0
End Select
End Function
Possible Test call
Dim procList, proc
procList = Split("getCookie,foo,myNewFunction", ",")
For Each proc In procList
MsgBox GetSyntax(ThisWorkbook, proc), vbInformation, proc
Next
I am trying to write some intermediate results in a user defined VBA function to a worksheet. I have tested the function, and it works correctly. I am aware that I cannot modify / write to cells from a UDF, so I tried passing the relevant results to a subroutine which I hoped would then be able to write to the spreadsheet.
Unfortunately my scheme doesn't work, and I am trying to think through this problem.
Public Function f(param1, param2)
result = param1 * param2
call writeToSheet(result)
f = param1 + param2
end
public sub writeToSheet(x)
dim c as range
c = range("A1")
c.value = x
end
I would like to see the product of param1 and param2 in cell A1. Unfortunately, it does not happen - the subroutine just ends abruptly as soon as it attempts to execute the first statement (c = range("A1") ). What am I doing wrong, and how can I fix it?
If it is simply impossible to write to a spreadsheet in this way, is there some other way in which to store intermediate results for later review? My real life problem is a little more complicated that my stylized version above, as I generate a new set of intermediate results each time I go through a loop, and want to store them all for review.
This idea might work for you. The function ParamProduct calls SetProps which writes both parameters to custom document properties (View from File > Properties > Advanced Properties > Custom). Call the function with =ParamProduct(A1, A2) or =ParamProduct(123, 321)
Function ParamProduct(Param1 As Variant, _
Param2 As Variant) As Double
Dim Fun As Double
Dim Param As Variant
Dim i As Integer
Param = Param1
For i = 1 To 2
SetProp "Param" & i, Param
Param = Param2
Next i
ParamProduct = Param1 + Param2
End Function
Private Sub SetProp(Pname As String, _
PropVal As Variant)
' assign PropVal to document Property(Pname)
' create a custom property if it doesn't exist
Dim Pp As DocumentProperty
Dim Typ As MsoDocProperties
If IsNumeric(PropVal) Then
Typ = msoPropertyTypeNumber
Else
Select Case VarType(PropVal)
Case vbDate
Typ = msoPropertyTypeDate
Case vbBoolean
Typ = msoPropertyTypeBoolean
Case Else
Typ = msoPropertyTypeString
End Select
End If
On Error Resume Next
With ThisWorkbook
Set Pp = .CustomDocumentProperties(Pname)
If Err.Number Then
.CustomDocumentProperties.Add Name:=Pname, LinkToContent:=False, _
Type:=Typ, Value:=PropVal
Else
With Pp
If .Type <> Typ Then .Type = Typ
.Value = PropVal
End With
End If
End With
End Sub
Use this UDF to recall the properties to the worksheet.
Function GetParam(ByVal Param As String) As Variant
GetParam = Propty(Param)
End Function
Private Function Propty(Pname As String) As Variant
' SSY 050 ++
' return null string if property doesn't exist
Dim Fun As Variant
Dim Pp As DocumentProperty
On Error Resume Next
Set Pp = ThisWorkbook.CustomDocumentProperties(Pname)
If Err.Number = 0 Then
Select Case Pp.Type
Case msoPropertyTypeNumber
Fun = CLng(Fun)
Case msoPropertyTypeDate
Fun = CDate(Fun)
Case msoPropertyTypeBoolean
Fun = CBool(Fun)
Case Else
Fun = CStr(Fun)
End Select
Fun = Pp.Value
End If
The worksheet function below works (A6 has a value of "Param2")
=GetParam("Param1")*GetParam(A6)
The above code will create a property if it doesn't exist or change its value if it does. The sub below will delete an existing property and do nothing if it's called to delete a property that doesn't exist. You might call it from one of the above subs or functions.
Private Sub DelProp(ByVal Pname As String)
On Error Resume Next
ThisWorkbook.CustomDocumentProperties(Pname).Delete
Err.Clear
End Sub
Thanks a mill everyone. Printing to the immediate window is the easiest by far, but allowed me to print only a single item. I therefore concatenated all 5 items into a single string and printed it in the immediate window:
dummystr = CStr(slope1) & ", " & CStr(intercept1) & ", " & CStr(slope2) & ", " & CStr(intercept2) & ", " & CStr(sse(i))
Debug.Print dummystr
This is the case:
I need to have two values back from a function: this function needs an input parameter to works.
strTitleName: input parameter
sName: output paramter
sScope: output paramter
Function getScenarioName(strTitleName As String, sName As String, sScope As String)
activateSheet ("Test Scenarios")
Dim rng1 As Range
Dim strSearch As String
strSearch = strTitleName & "*"
Set rng1 = Range("B:B").Find(strSearch, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
'getScenarioName = rng1.Offset(0, 0)
sName = rng1.Address
sScope = rng1.Offset(1, 1).Address
Debug.Print "sName=" & sName
Debug.Print "sScope=" & sScope
End If
How can I getout in a subroutine the values of sName and sScope?
The concept at play here is ByRef vsByVal parameters.
In VBA parameters are passed by reference unless specified otherwise, which is... an unfortunate default: in most other languages, parameters are passed by value.
99% of the time, you don't need to pass anything ByRef, so ByVal is perfect, and should be specified explicitly... 99% of the time.
Passing parameters ByRef is useful for cases like this, when you need to return two or more values and returning an instance of a class encapsulating the return values would be overkill.
Keep in mind that a Function procedure always returns a value, even if you don't declare a return type. If you fail to declare a return type, and never assign a return value, the function will return Variant/Empty, which makes for a rather confusing and non-idiomatic API.
Here are a couple options:
ByRef return parameters
Say your signature looked like this:
Public Function GetScenarioName(ByVal title As String, ByRef outName As String, ByRef outScope As String) As Boolean
Now you can return True when the function succeeds, False when it doesn't (say, if rng1 happens to be Nothing), and then assign the outName and outScope parameters.
Because they're passed by reference, the calling code gets to see the new values - so the caller would look like this:
Dim scenarioTitle As String
scenarioTitle = "title"
Dim scenarioName As String, scenarioScope As String
If GetScenarioName(scenarioTitle, scenarioName, scenarioScope) Then
Debug.Print scenarioName, scenarioScope
Else
Debug.Print "No scenario was found for title '" & scenarioTitle & "'."
End If
What happens is that the function receives a copy of the scenarioTitle variable - that copy is essentially a variable that's local to the function: if you re-assign it in the body of the function, the caller doesn't get to see the updated value, the original argument remains unaffected (and this is why ByVal is the safest way to pass parameters).
But the function also receives a reference to the scenarioName and scenarioScope variables - and when it assigns to its outName and outScope parameters, the value held by that reference is updated accordingly - and the caller gets to see the updated values.
User-Defined Type
Still leveraging ByRef return values, it can sometimes be a good idea to encapsulate members in a cohesive unit: VBA lets you create user-defined types, for the simple cases where you just need to toss a bunch of values around:
Public Type TScenario
Title As String
Name As String
Scope As String
'...
End Type
Public Function GetScenarioInfo(ByRef info As TScenario) As Boolean
Now this function would work similarly, except now you no longer need to change its signature whenever you want to add a parameter: simply add the new member to TScenario and you're good to go!
The calling code would be doing this:
Dim result As TScenario
result.Tite = "title"
If GetScenarioInfo(result) Then
Debug.Print result.Name, result.Scope
Else
Debug.Print "No scenario was found for title '" & result.Title & "'."
End If
Alternatively, you could have a full-fledged class module to encapsulate the ScenarioInfo - in which case...
Full-Blown OOP
Encapsulating everything you need in its own class module gives you the most flexibility: now your function can return an object reference!
Public Function GetScenarioName(ByVal title As String) As ScenrioInfo
Now the function can return Nothing if no scenario is found, and there's no need for any parameters other than the input one:
Dim scenarioTitle As String
scenarioTitle = "title"
Dim result As ScenarioInfo
Set result = GetScenarioInfo(scenarioTitle)
If Not result Is Nothing Then
Debug.Print result.Name, result.Scope
Else
Debug.Print "No scenario was found for title '" & scenarioTitle & "'."
End If
This is IMO the cleanest approach, but does require a bit of boilerplate - namely, the ScenarioInfo class module. The simplest possible implementation would simply expose read/write public fields:
Option Explicit
Public Name As String
Public Scope As String
More elaborate implementations could involve an IScenarioInfo interface that only exposes Property Get members, the ScenarioInfo class that Implements IScenarioInfo, a VB_PredeclaredId attribute (that's... hidden... and much easier to handle with the Rubberduck VBIDE add-in) with a public factory method that lets you parameterize the object's creation - turning the function into something like this:
If Not rng1 Is Nothing Then
Set GetScenarioInfo = ScenarioInfo.Create(rng1.Address, rng1.Offset(1,1).Address)
End If
If that's an approach you find interesting, you can read up about it on the Rubberduck News blog, which I maintain.
You can create an array inside the function to store both values. Then, return the array.
For example:
'If strTitleName is your only argument, then:
Function getScenarioName(strTitleName As String) As Variant
Dim rng1 As Range
Dim strSearch As String
Dim result(1) As String
activateSheet ("Test Scenarios")
Set rng1 = Range("B:B").Find(strSearch, , xlValues, xlWhole)
strSearch = strTitleName & "*"
result(0) = ""
result(1) = ""
If Not rng1 Is Nothing Then
sName = rng1.Address
sScope = rng1.Offset(1, 1).Address
Debug.Print "sName=" & sName
Debug.Print "sScope=" & sScope
result(0) = "sName=" & sName
result(1) = "sScope=" & sScope
End If
getScenarioName = result
End Function
Using #Freeflow's suggestion of the collection, here's your updated code:
Function getScenarioName(strTitleName As String, sName As String, sScope As String) as Collection
activateSheet ("Test Scenarios")
Dim rng1 As Range
Dim strSearch As String
strSearch = strTitleName & "*"
Set rng1 = Range("B:B").Find(strSearch, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
'getScenarioName = rng1.Offset(0, 0)
sName = rng1.Address
sScope = rng1.Offset(1, 1).Address
dim colToReturn as Collection
set colToReturn = New Collection
colToReturn.Add sName
colToReturn.Add sScope
Set getScenarioName = colToReturn
End If
End Function
I have a worksheet that upon opening it makes sure that every sheet has a button. So when a new sheet is present that doesn't have a button, it is set to add it. A few months ago I'm pretty sure this worked, but now (after not using this sheet for several months) I'm getting error '1004': "Unable to get the Add property of the OLEObjects class." The error occurs on the "set btn" line. What is causing this and how can I fix it?
Private btn As OLEObject
Public Const sButtonName1 As String = "btnTorqueCurveFit"
Public Const sBtnMessage1 As String = "Calculate Constant Torque Constants"
Public Const sButtonName2 As String = "btnESPCurveFit"
Public Const sBtnMessage2 As String = "Calculate Constant ESP Constants"
Public Const sButtonLeft1 As Long = 302.25
Public Const sButtonLeft2 As Long = 364.25
Private Sub AddTorqueButton(n As Worksheet)
'Add a Button to the Sheet
Set btn = n.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=" & sButtonLeft1 &", Top:=3.75, Width:=60, Height:=57.75)
btn.Name = sButtonName1
btn.Object.Caption = sBtnMessage1
btn.Object.Font.Bold = True
btn.Object.WordWrap = True
'Modify the sheet's code to have newly added button call the general code in the module
Dim codeblock As CodeModule
Dim vbComp As VBComponent
Dim lineC As Integer
Dim Ap As String, _
Lf As String, _
Tabs As String, _
inputStr As String
Set vbComp = ActiveWorkbook.VBProject.VBComponents(n.CodeName)
Set codeblock = vbComp.CodeModule
Tabs = Chr(9)
Lf = Chr(10)
Ap = Chr(34)
inputStr = "Private Sub " & sButtonName1 & "_Click()" & Lf & Tabs & _
"ConstTorqueButtonAction ActiveSheet" & Lf & _
"End Sub"
With codeblock
lineC = .CountOfLines + 1
.InsertLines lineC, inputStr
End With
End Sub
Macro settings = 'Enable All,' Active X settings = 'Enable All,' the document is networked, but network documents are set to be trusted. It seem to be an issue with this workbook specifically as I have another workbook that use the same "set btn" style of code and it work on this machine, but the code displayed above produces an error. Any help or insight is appreciated.
The reason for the error is the way that the Left argument is specified when calling OLEObjects.Add. There is no need to be passing it as a string and the & characters around it are unnecessary. In fact, that whole thing causes the error.
Since the constant sButtonLeft1 is already of type Long, you should just be passing it directly. Therefore, instead of passing a string like this:
... , Left:=" & sButtonLeft1 &", ...
you should be calling it with the long parameter directly like this:
... , Left:=sButtonLeft1, ...
This should resolve the problem.