VBA Custom Functions

The Quote VBA Custom Function

In this tutorial I walk you through three VBA custom functions a.k.a (also known as) user defined functions.
1. a VBA custom function to retrieve the latest stock price
2. a VBA custom function to count how many times a word appears in a text string.
3. a VBA custom function to determine if a potential customer is in the service area.

#1 The Quote Custom Function VBA

Quote Custom Function references required
You’ll note from the formula bar on the left that Quote Custom Function only requires one input: a valid stock ticker symbol. All Functions start with a Function and end with a End Function. A Custom Function: 1. Cannot alter the structure of a Worksheet, such as changing the Worksheet name, turning off grid lines, protecting the Worksheet, etc. 2. Cannot change a physical characteristic of a cell, including the one that houses the CF (we cannot use a CF to change the font color, background color, etc of any cell). 3. Cannot be used to change any part of another cell in any way at all.The Quote Custom VBA function requires the references I have identified on the left. I’ve enhanced the annotation in the code to explain what is does step by step. 
Function Quote(sSymbol As String) As Variant

'*******************************************************************
'** Date:           February 26, 2019
'** Developer:      Ray Mills
'**                 www.ExcelandVBACraftsman.com
'** Re:             Custom function to return the most recent quote
'**                 uses API provided by IEXTrading
'********************************************************************

Dim sMisc As String, myurl As String
Dim y As Integer
Dim xmlhttp As New MSXML2.XMLHTTP60


' First build the URL ...
' Then use a http request to pull in price ...

    myurl = "https://api.iextrading.com/1.0/stock/" & sSymbol & "/quote"
    xmlhttp.Open "GET", myurl, False
    xmlhttp.Send
    sMisc = xmlhttp.ResponseText


' If the response text comes back 'Unknown symbol" ...
' Alert the user and exit the Function ...

    If sMisc = "Unknown symbol" Then
    Quote = "Unknown ticker"
    Exit Function
    End If
    
'clean up the response text ...
    sMisc = Replace(sMisc, ":", "") sMisc = Replace(sMisc, ",", "")
    sMisc = Replace(sMisc, "  ", " ")
    sMisc = Replace(sMisc, """", "|")
    sMisc = Replace(sMisc, "| || ", "")
    sMisc = Replace(sMisc, "| |", "|")
    sMisc = Replace(sMisc, "||", "|")
    sMisc = Replace(sMisc, "}", "")


' After cleaning up the response text  ...
' I create a variant that has the results split by component ...
varresponse = Split(sMisc, "|")

' Search for the latestPrice variant...
' Then use the next variant and post the actual latest price ...
For y = 0 To UBound(varresponse)
                If varresponse(y) = "latestPrice" Then
                Quote = varresponse(y + 1)
                Exit For
                End If
            Next y


End Function
#1 The WordCount Custom Function 
You will note the Custom VBA Function WordCount Uses 2 input variables:
sSearchText which is the text you are searching in
cSearchWord which is the search word you are looking for
the code is extremely simple and the annotation should guide you through the steps.

 

WordCount Custom VBA Function 
Function WordCount(sSearchText As String,  sSearchWord As String) As Integer

'*******************************************************************
'** Date:           February 26, 2019
'** Developer:      Ray Mills
'**                 www.ExcelandVBACraftsman.com
'** Re:             Custom function to return the most recent quote
'** sSearchText     The text you are searching through
'** sSearchword     the word you are searching for
'********************************************************************

Dim x As Integer
Dim vSplit As Variant

' clean up text...
sSearchText = Replace(sSearchText, "-", "")
sSearchText = Replace(sSearchText, ".", "")
sSearchText = Replace(sSearchText, ",", "")
sSearchText = Replace(sSearchText, ";", "")

' split the sSearch text into individual words...
vSplit = Split(UCase(sSearchText), " ")


' loop through all the words looking for our search word ...
' if found increment the counter ...
WordCount = 0
For x = 0 To UBound(vSplit)
    If UCase(sSearchWord) = vSplit(x) Then
    WordCount = WordCount + 1
    End If
Next x


End Function
VBA Custom Function Example III using VBA Select Case Statement as a Practical Example Anthony’s Plumbing started as a 1 truck shop 25 years ago.  His dedication to customer service, honesty and good work did its magic and Anthony expanded over the years. He now employs 5 master plumbers and 3 plumbing apprentices and has 5 trucks.  The reputation for good honest work however had some unexpected problems.  Even though both his web site and his yellow pages ad indicate what towns he covers- out of towners continue to call.   Anthony has asked you to create a vba custom function that will allow his dispatcher to input the customer’s zip code and immediately identify them as ‘outside normal service area’.
VBA Select Case Function
This is the Appointment screen that Anthony’s Plumbing uses to schedule home appointments.  We use a VBA custom function “iZone” to set the zone color to:
Zone 1 Green – Normal Service Area
Zone 2 Brown – Travel Surcharge Area
Zone 3 Red Flashing – Not  in service area

When the dispatcher enters the customer’s zip code the TxtZip_Change event is fired and the zip code is evaluated by the custom function and then the color of the Zone label is adjusted accordingly.  The flashing red zone 3 is added to be sure the dispatcher is alerted that the customer is out of Anthony’s service area.
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Function iZone(sZipcode As String) As Integer
' the customer provides their zip code Anyone in zone 1
' gets a normal service of $65 those in zone 2 are charged
' $90 for the additional travel time.  Anyone else those
' in zone 3 are not offered service

Select Case sZipcode
     Case 19060, 19061, 19014, 19810, 19317, 19809
          iZone = 1
     Case 19382, 19348, 19707, 19807, 19803
          iZone = 2
     Case Else
          iZone = 3
End Select

End Function


Private Sub txtZip_Change()

' when the dispatcher enters the zip code the izone
' custom function is called and assigned to the variable i
' based on the value of i the label lblZone color is updated
' if the zone is 3 the red label is flashed a couple of times


Dim i As Integer, x As Integer
If Len(Me.txtZip.Text) = 5 Then
i = iZone(Me.txtZip.Text)

If i = 1 Then
     Me.lblZone.Visible = True
     Me.lblZone.Caption = "Zone 1"
     Me.lblZone.ForeColor = &H8000&
ElseIf i = 2 Then
     Me.lblZone.Visible = True
     Me.lblZone.Caption = "Zone 2"
     Me.lblZone.ForeColor = &H40C0&
Else
    Me.lblZone.Visible = True
    Me.lblZone.Caption = "Zone 3"
    Me.lblZone.ForeColor = &HFF&

    For x = 1 To 4
       Me.lblZone.Visible = False
       Me.Repaint
       Sleep (500)
      Me.lblZone.Visible = True
      Me.Repaint
      Sleep (500)
 Next x
End If
End If


End Sub
If you were able to utilize what you learned here or improve the code, please
leave a comment Here

 

If you enjoyed this post or found it helpful andl would like to say hello and
buy me a cup of coffee Click here

Raymond Mills MBA, MS
Raymond Mills, M.B.A., M.S.  has spent over 20 years of his career as Accountant, Investment Bank and Credit Card Technical Auditor/ Data Analyst.  His specialty was using Excel to get Big Databases including Teradata, Oracle,  Squel Server and Sybase to give up their secrets.
Ray has said “I love nothing better than using VBA to unleash the power of Microsoft Office.” You can contact Ray @ 484 574-3190 or by emailing him Here

If you have a challenge with Excel, Access or Word and would like to speak with Ray, you can get his contact details by clicking here: Contact Me

Comments are closed.