Cannot trap error when using Excel's built-in stock price functionality in a macro. It used to work well!

[OaklandJim]

This is quite disappointing and frustrating...I am trying to make an investment portfolio workbook for a friend that retrieves stock/etf prices using Excel's built-in functionality. SOMETIMES when putting the link-to-price for a symbol into a cell there is an error generated, whether it is done manually or in code. Sometimes it works as expected.

Whether adding the link manually or in code the error message is "Something went wrong on our side and we couldn't link all your data. We're working to fix it"

When done in VBA, code is supposed to trap the error when it does happen and give user instructions to "Try Again". It worked well. But now it always generates a 1004 error.

But all of a sudden the error trapping does not work. It is ignored and the Excel debugger dialog appears and the offending line of code is highlighted. Needless to say, I do not want the user -- and Excel lightweight -- to learn about macro errors to use the workbook!

Is there something I'm missing? A reference? A different way to code the link-to-price insertion into a cell? More robust error trapping?

                sStepID = "Setting link-to-price for " & rCell.Value
                
                sErrMsg = "Sometimes setting the link-to-price for" & Chr(10) _
                        & "a symbol does not work so TRY AGAIN!"

                On Error GoTo ErrHandler
                
'               Error occurs here.                
'               Try to put the link--to-price for the Symbol into its corresponding link cell.
                rCell.Offset(0, 1).ConvertToLinkedDataType ServiceID:=268435456, LanguageCulture:="en-US"
            
            End If

        Next rCell
    
    End With
    
Exit Sub

ErrHandler:

Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID, sErrMsg)

End Sub

'
' ----------------------------------------------------------------
' Procedure Name: ErrorMessage
' Purpose: Use to render the error messages from error handler.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter piErrNum (Long): The Excel error number from the error handler.
' Parameter psErrDescr (): The Excel error description from the error handler.
' Parameter psSubName (): Name of calling sub or function.
' Parameter psStepID (): Name of the step within caller where the error occurred.
' Parameter psErrMsg (): Message to user about the error.
' Author: Jim
' Date: 7/24/2020
' ----------------------------------------------------------------

Function ErrorMessage( _
    piErrNum As Long, _
    psErrDescr As String, _
    Optional psSubName As String = "", _
    Optional psStepID As String = "", _
    Optional psErrMsg As String = "")

'   User interrupted operation
'    If piErrNum = 18 Then Exit Function

    On Error GoTo 0
    
    Dim sMsg As String

    Dim sTitle As String

    sTitle = "Error Message"

    sMsg = "Error #" & piErrNum & " occurred"

    If psSubName <> "" _
     Then sMsg = sMsg & " in procedure " & psSubName

    sMsg = sMsg & "."
    
    sMsg = sMsg & Chr(10) & Chr(10) & "Error Type: " & psErrDescr

    If Right(psErrDescr, 1) <> "." And Right(psErrDescr, 1) <> "!" _
     Then sMsg = sMsg & "."
    
    If psStepID <> "" _
     Then
        sMsg = sMsg & Chr(10) & Chr(10) & "Step ID: " & psStepID

        If Right(psStepID, 1) <> "." _
         Then sMsg = sMsg & "."
    End If

    If psErrMsg <> "" _
     Then
        sMsg = sMsg & Chr(10) & Chr(10) & psErrMsg

        If Right(psErrMsg, 1) <> "." And Right(psErrMsg, 1) <> "!" _
         Then sMsg = sMsg & "."
    End If
    
    MsgBox sMsg, vbOKOnly + vbCritical, sTitle

    Err.Clear

    Application.StatusBar = False

End Function
'

 

[OaklandJim]

Of course I used this site's "show formula" functionality instead of the show vba code.

Here is code shown correctly. I sure hope that someone can help me. I feel like an idiot after promising to create a functioning portfolio workbook for my good friend.

After a lot of messing around I conclude that I cannot trap the error generated when trying to establish a link-to-price for a symbol.

I have to conclude that Excel's stock price retrieval functionality is quite flakey! I use Stock Connector for my portfolio workbook but that has issues and quirks too.

' ----------------------------------------------------------------
' Procedure Name: SetNewPriceDataLinks
' Purpose: Set link-to-price for new stocks and funds entered by user.
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 8/21/2024
' Comments: Iterate all cells in the Symbols range. First, determine if
'           there are any new entries. If so then sub adds the link-to-price
'           for new holding(s) entered to retrieve the price for an issue.
'           That link-to-price uses Excel's built-in stock price retrieval
'           functionality.
' ----------------------------------------------------------------

Sub SetNewPriceDataLinks()

'   ----------------------
'       Error Handling
'   ----------------------
    Dim sSubName As String
    Dim sStepID As String
    Dim sErrMsg As String
   
    sSubName = "SetNewPriceDataLinks"
    sStepID = ""
    sErrMsg = ""
    On Error GoTo ErrHandler
'   ----------------------
   
    sStepID = "Declarations"
   
    Dim rCell As Range
   
    Dim rSymbols As Range
       
    Set rSymbols = [Prices].Range("SymbolsList")

    With [Prices]
   
        sStepID = "Checking for new holding(s)"

'       Iterate through each symbol cell to dtermine if there is a new holding(s).
'       Note that rCell.value = symbol and rCell.Offset(0, 2).Value = price.
        For Each rCell In rSymbols
       
'           Is a new entry if len symbol >0 and len price = 0. If so then
'           1. a new entry was found and 2. exit for.
            If Len(rCell.Value) <> 0 And Len(rCell.Offset(0, 2).Value) = 0 _
             Then
               
                Exit For
           
'           No new holding(s) exist if encountering this scenario: len symbol = 0 AND
'           len price = 0. If so then 1. tell user "no new holdings (entered)" and 2. exit sub.
            ElseIf Len(rCell.Value) = 0 _
               And Len(rCell.Offset(0, 2).Value) = 0 _
             Then

                MsgBox "No new holding(s) symbol(s) were found", vbOKOnly + vbInformation, "Adding new holdings."
                Exit Sub
           
            End If

        Next rCell
       
        sStepID = "Iterating through symbols' cells"
          
'       Iterate all symbols cells to process any new holding(s) entered by user.
        For Each rCell In rSymbols
       
            sErrMsg = "" _

'           Process cells in the Symbols range. If encountering an empty cell
'           then there are no more symbols to iterate through.
            sStepID = "Checking symbol cell is empty. If so then done."
       
            If rCell.Value = "" _
             Then
                sStepID = "Sorting symbols in price worksheet"
               
                Application.ScreenUpdating = False
               
                Call SortHoldings
               
                Exit Sub
            End If
           
            sStepID = "Checking price cell is a string"

'           Establish the link-to-price for the current symbol if 1. Typename
'           for the price is String or if the cell contents is zero length.
            If TypeName(rCell.Offset(0, 2).Value) = "String" _
               Or Len(rCell.Offset(0, 2).Value) = 0 _
             Then
               
                sStepID = "Putting symbol into link cell"
               
'               Make the symbol upper case.
                rCell.Value = UCase(rCell.Value)
                               
'               Put the symbol into the link cell.
                rCell.Offset(0, 1).Value = rCell.Value
               
                On Error GoTo ErrHandler
               
                sStepID = "Setting link-to-price for " & rCell.Value
               
                sErrMsg = "Sometimes setting the link-to-price for" & Chr(10) _
                        & "a symbol does not work so TRY AGAIN!"
               
'               OFFENDING CODE IS JUST BELOW!

'               Try to put the link--to-price for the symbol into its corresponding link cell,
'               one cell to the right of the symbol cell.
                rCell.Offset(0, 1).ConvertToLinkedDataType ServiceID:=268435456, LanguageCulture:="en-US"
           
            End If

        Next rCell

    End With
   
Exit Sub

ErrHandler:

Call ErrorMessage(Err.Number, Err.Description, sSubName, sStepID, sErrMsg)

End Sub

Option Explicit
'
' ----------------------------------------------------------------
' Procedure Name: ErrorMessage
' Purpose: Use to render the error messages from error handler.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter piErrNum (Long): The Excel error number from the error handler.
' Parameter psErrDescr (): The Excel error description from the error handler.
' Parameter psSubName (): Name of calling sub or function.
' Parameter psStepID (): Name of the step within caller where the error occurred.
' Parameter psErrMsg (): Message to user about the error.
' Author: Jim
' Date: 7/24/2020
' ----------------------------------------------------------------

Function ErrorMessage( _
    piErrNum As Long, _
    psErrDescr As String, _
    Optional psSubName As String = "", _
    Optional psStepID As String = "", _
    Optional psErrMsg As String = "")

'   User interrupted operation
'    If piErrNum = 18 Then Exit Function

    On Error GoTo 0
   
    Dim sMsg As String

    Dim sTitle As String

    sTitle = "Error Message"

    sMsg = "Error #" & piErrNum & " occurred"

    If psSubName <> "" _
     Then sMsg = sMsg & " in procedure " & psSubName

    sMsg = sMsg & "."
   
    sMsg = sMsg & Chr(10) & Chr(10) & "Error Type: " & psErrDescr

    If Right(psErrDescr, 1) <> "." And Right(psErrDescr, 1) <> "!" _
     Then sMsg = sMsg & "."
   
    If psStepID <> "" _
     Then
        sMsg = sMsg & Chr(10) & Chr(10) & "Step ID: " & psStepID

        If Right(psStepID, 1) <> "." _
         Then sMsg = sMsg & "."
    End If

    If psErrMsg <> "" _
     Then
        sMsg = sMsg & Chr(10) & Chr(10) & psErrMsg

        If Right(psErrMsg, 1) <> "." And Right(psErrMsg, 1) <> "!" _
         Then sMsg = sMsg & "."
    End If
   
    MsgBox sMsg, vbOKOnly + vbCritical, sTitle

    Err.Clear

    Application.StatusBar = False

End Function
'