Error trapping for historical stock data query

A

artz

Well-known Member
Joined
Aug 11, 2002
Messages
830
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I've been using the code below in many stock analysis workbooks and generally, it works just fine. If I fat finger a wrong ticker and the sub doesn't run, I just click on "End" and go back and retype the ticker. I do the same when I lose my internet connection and get an error.

It would be nice though if these errors could be trapped with a "Ticker not found" message and a "No data connection" for the second. The code for the query is below:
Code: 
Sub GetData()
'   thanks to Ron McEwan :^)

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim EndDate As Date
    Dim StartDate As Date
    Dim Symbol As String
    Dim qurl As String
    Dim nQuery As Name
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    
    Set DataSheet = ActiveSheet
  
        StartDate = DataSheet.Range("B2").Value
        EndDate = DataSheet.Range("B3").Value
        Symbol = DataSheet.Range("B4").Value
        Range("C7").CurrentRegion.ClearContents
        
'construct the URL for the query
        
        qurl = "http://chart.yahoo.com/table.csv?s=" & Symbol
        qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
            "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
            Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Range("C3") & "&q=q&y=0&z=" & _
            Symbol & "&x=.csv"
        Range("b5") = qurl
                   
QueryQuote:
             With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
            End With
            
            Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=True, Space:=False, other:=False
            
            Range(Range("C7"), Range("C7").End(xlDown)).NumberFormat = "mmm d/yy"
            Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "0.00"
            Range(Range("H7"), Range("H7").End(xlDown)).NumberFormat = "0,000"
            Range(Range("I7"), Range("I7").End(xlDown)).NumberFormat = "0.00"


    With ThisWorkbook
        For Each nQuery In Names
            If IsNumeric(Right(nQuery.Name, 1)) Then
                nQuery.Delete
            End If
        Next nQuery
    End With
    
'turn calculation back on
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Range("C7:I2000").Select
    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("C1").Select
    Selection.ColumnWidth = 12

    Range("B4").Select

End Sub
As I suggested above, Mr.McEwan's code has been a trooper in many historical stock price queries posted online. Is there anyone here in the Forum who could take a stab with some VBA code to trap these errors? I am sure that users of Mr.McEwan's query code would be highly grateful. (As would I :))

Thanks,

Art
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
Hi Art, I've added error handling in the code below along with making the code more consistent in referencing the worksheet directly.

Code: 
Sub GetData()
' based on code by Ron McEwan

 Dim DataSheet As Worksheet
 Dim EndDate As Date
 Dim StartDate As Date
 Dim Symbol As String
 Dim qurl As String
 Dim sErrMsg As String
 Dim nQuery As Name

 On Error GoTo ErrProc
  
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Application.Calculation = xlCalculationManual
    
 Set DataSheet = ActiveSheet
 
 With DataSheet
   StartDate = .Range("B2").Value
   EndDate = .Range("B3").Value
   Symbol = .Range("B4").Value
   .Range("C7").CurrentRegion.ClearContents
 End With
 
'construct the URL for the query
 qurl = "http://chart.yahoo.com/table.csv?s=" & Symbol
 qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
    "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
    Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Range("C3") & "&q=q&y=0&z=" & _
    Symbol & "&x=.csv"
 
 With DataSheet
   .Range("b5") = qurl
   With .QueryTables.Add(Connection:="URL;" & qurl, Destination:=.Range("C7"))
      .BackgroundQuery = True
      .TablesOnlyFromHTML = False
      .Refresh BackgroundQuery:=False
      .SaveData = True
   End With

   .Range("C7").CurrentRegion.TextToColumns _
      Destination:=.Range("C7"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
      Semicolon:=False, Comma:=True, Space:=False, other:=False

   Range(.Range("C7"), .Range("C7").End(xlDown)).NumberFormat = "mmm d/yy"
   Range(.Range("D7"), .Range("G7").End(xlDown)).NumberFormat = "0.00"
   Range(.Range("H7"), .Range("H7").End(xlDown)).NumberFormat = "0,000"
   Range(.Range("I7"), .Range("I7").End(xlDown)).NumberFormat = "0.00"

   .Range("C7:I2000").Sort Key1:=.Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   .Range("C1").EntireColumn.ColumnWidth = 12

   .Range("B4").Select
 End With

 With ThisWorkbook
   For Each nQuery In Names
      If IsNumeric(Right(nQuery.Name, 1)) Then
         nQuery.Delete
      End If
   Next nQuery
 End With

ExitProc:
 On Error Resume Next
    
'turn calculation back on
 Application.Calculation = xlCalculationAutomatic
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
 If Len(sErrMsg) Then MsgBox sErrMsg
 Exit Sub

ErrProc:
 sErrMsg = Err.Number & ": " & Err.Description
 Resume ExitProc
End Sub
 
Last edited:
Upvote 0
Hi Jerry,

Thanks for taking a stab at this; I really appreciate it. I probably should have posted all the Module code. Here's why. The errors are definitely trapped but now the screen updating is a little wonky. Before using your code, if I clicked the download button, the charts were "neatly" updated. Now the charts kind of flash and it doesn't look clean.

Below is the Module code:
Code: 
Sub GetTwo()
'clear data

    Range("K8:M300").Select
    Selection.ClearContents
    Range("P8:R300").Select
    Selection.ClearContents
    
' get first stock
    Range("B4") = Range("M6")
    GetData
    Range("E8:G1000").Select
    Selection.Copy
    Range("K8").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    UpdateScale1
    
' get second stock
    Range("B4") = Range("R6")
    GetData
    Range("E8:G1000").Select
    Selection.Copy
    Range("P8").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Range("AA8:GG1000").Select
    Selection.Copy
    UpdateScale2

Range("A1").Select
End Sub




Sub GetData()
' based on code by Ron McEwan

 Dim DataSheet As Worksheet
 Dim EndDate As Date
 Dim StartDate As Date
 Dim Symbol As String
 Dim qurl As String
 Dim sErrMsg As String
 Dim nQuery As Name

 On Error GoTo ErrProc
  
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Application.Calculation = xlCalculationManual
    
 Set DataSheet = ActiveSheet
 
 With DataSheet
   StartDate = .Range("B2").Value
   EndDate = .Range("B3").Value
   Symbol = .Range("B4").Value
   .Range("C7").CurrentRegion.ClearContents
 End With
 
'construct the URL for the query
 qurl = "http://chart.yahoo.com/table.csv?s=" & Symbol
 qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
    "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
    Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Range("C3") & "&q=q&y=0&z=" & _
    Symbol & "&x=.csv"
 
 With DataSheet
   .Range("b5") = qurl
   With .QueryTables.Add(Connection:="URL;" & qurl, Destination:=.Range("C7"))
      .BackgroundQuery = True
      .TablesOnlyFromHTML = False
      .Refresh BackgroundQuery:=False
      .SaveData = True
   End With

   .Range("C7").CurrentRegion.TextToColumns _
      Destination:=.Range("C7"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
      Semicolon:=False, Comma:=True, Space:=False, other:=False

   Range(.Range("C7"), .Range("C7").End(xlDown)).NumberFormat = "mmm d/yy"
   Range(.Range("D7"), .Range("G7").End(xlDown)).NumberFormat = "0.00"
   Range(.Range("H7"), .Range("H7").End(xlDown)).NumberFormat = "0,000"
   Range(.Range("I7"), .Range("I7").End(xlDown)).NumberFormat = "0.00"

   .Range("C7:I2000").Sort Key1:=.Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   .Range("C1").EntireColumn.ColumnWidth = 12

   .Range("B4").Select
 End With

 With ThisWorkbook
   For Each nQuery In Names
      If IsNumeric(Right(nQuery.Name, 1)) Then
         nQuery.Delete
      End If
   Next nQuery
 End With

ExitProc:
 On Error Resume Next
    
'turn calculation back on
 Application.Calculation = xlCalculationAutomatic
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
 If Len(sErrMsg) Then MsgBox sErrMsg
 Exit Sub

ErrProc:
 sErrMsg = Err.Number & ": " & Err.Description
 Resume ExitProc
End Sub
Sub UpdateScale1()
Dim ChartVar As chart
Dim lMax As Long, lMin As Long

On Error GoTo ScalingProblem
    'Assigns the values in the Min and Max ranges to variables.
    With Sheet1
        lMax = .Range("One_Max").Value
        lMin = .Range("One_Min").Value
        'Creates chart object.
        Set ChartVar = .ChartObjects("Chart 32").chart
     
            
               With ChartVar.Axes(xlValue, xlPrimary)  'Adjusts the price axis
                   .MinimumScale = lMin
                   .MaximumScale = lMax
               End With
            
    End With
Exit Sub

ScalingProblem:
RetrievalProblem:
    MsgBox "Unable to update chart scale.", vbCritical + vbOKOnly, "Scaling Error"
End Sub
Sub UpdateScale2()
Dim ChartVar As chart
Dim lMax As Long, lMin As Long

On Error GoTo ScalingProblem
    'Assigns the values in the Min and Max ranges to variables.
    With Sheet1
        lMax = .Range("Two_Max").Value
        lMin = .Range("Two_Min").Value
        'Creates chart object.
        Set ChartVar = .ChartObjects("Chart 48").chart
     
            
               With ChartVar.Axes(xlValue, xlPrimary)  'Adjusts the price axis
                   .MinimumScale = lMin
                   .MaximumScale = lMax
               End With
            
    End With
Exit Sub

ScalingProblem:
RetrievalProblem:
    MsgBox "Unable to update chart scale.", vbCritical + vbOKOnly, "Scaling Error"
End Sub
Could you take a look and see if you can fix this?

Thanks so much,

Art
 
Upvote 0
Art,

You can move the Application setting and error handling from the front and end of GetData over to the front and end of GetTwo.
 
Upvote 0
Hi Jerry,

Thanks for your response and comments. I don't quite follow what you are suggesting to do. i read what you are saying, but don't exactly know what to move where.

Art
 
Upvote 0
Hi Art,

Here's what I was suggesting for those two subs. Note that there's no need to Select objects before copying them. It's more efficient and clearer coding to directly reference the objects without selecting them.

Code: 
Sub GetTwo()
 Dim sErrMsg As String
 
 On Error GoTo ErrProc
  
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Application.Calculation = xlCalculationManual

'clear data
 Range("K8:M300").ClearContents
 Range("P8:R300").ClearContents
    
' get first stock
 Range("B4") = Range("M6")
 GetData
 Range("E8:G1000").Copy
 Range("K8").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
 UpdateScale1
    
' get second stock
 Range("B4") = Range("R6")
 GetData
 Range("E8:G1000").Copy
 Range("P8").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        
'---this doesn't appear to be used/needed
[COLOR="#FF0000"] Range("AA8:GG1000").Select
 Selection.Copy[/COLOR]
    
 UpdateScale2

 Range("A1").Select

ExitProc:
 On Error Resume Next
    
'turn calculation back on
 Application.Calculation = xlCalculationAutomatic
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
 If Len(sErrMsg) Then MsgBox sErrMsg
 Exit Sub

ErrProc:
 sErrMsg = Err.Number & ": " & Err.Description
 Resume ExitProc

End Sub


Sub GetData()
' based on code by Ron McEwan

 Dim DataSheet As Worksheet
 Dim EndDate As Date
 Dim StartDate As Date
 Dim Symbol As String
 Dim qurl As String
 Dim nQuery As Name

    
 Set DataSheet = ActiveSheet
 
 With DataSheet
   StartDate = .Range("B2").Value
   EndDate = .Range("B3").Value
   Symbol = .Range("B4").Value
   .Range("C7").CurrentRegion.ClearContents
 End With
 
'construct the URL for the query
 qurl = "http://chart.yahoo.com/table.csv?s=" & Symbol
 qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
    "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
    Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Range("C3") & "&q=q&y=0&z=" & _
    Symbol & "&x=.csv"
 
 With DataSheet
   .Range("b5") = qurl
   With .QueryTables.Add(Connection:="URL;" & qurl, Destination:=.Range("C7"))
      .BackgroundQuery = True
      .TablesOnlyFromHTML = False
      .Refresh BackgroundQuery:=False
      .SaveData = True
   End With

   .Range("C7").CurrentRegion.TextToColumns _
      Destination:=.Range("C7"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
      Semicolon:=False, Comma:=True, Space:=False, other:=False

   Range(.Range("C7"), .Range("C7").End(xlDown)).NumberFormat = "mmm d/yy"
   Range(.Range("D7"), .Range("G7").End(xlDown)).NumberFormat = "0.00"
   Range(.Range("H7"), .Range("H7").End(xlDown)).NumberFormat = "0,000"
   Range(.Range("I7"), .Range("I7").End(xlDown)).NumberFormat = "0.00"

   .Range("C7:I2000").Sort Key1:=.Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   .Range("C1").EntireColumn.ColumnWidth = 12

   .Range("B4").Select
 End With

 With ThisWorkbook
   For Each nQuery In Names
      If IsNumeric(Right(nQuery.Name, 1)) Then
         nQuery.Delete
      End If
   Next nQuery
 End With

End Sub
 
Upvote 0
Hi Jerry,

Thanks for taking a second look. It's funny, I didn't receive a notice from the Forum that you had reposted. Hmmm.... So I just got your new code and stuffed into in my workbook. The first time that I clicked the Download button, the screen looked almost static; barely a perception that the ticker data had been downloaded and the charts updated.

So I thought, alright, this is great; let's start using the workbook. Unfortunately when I changed both tickers and clicked Download, I got no data plotted in the charts at all; and no error messages. Like I said in my previous post, that first code worked to trap errors, but the screen updating kind of jumped around.

Any thoughts? Too bad we don't have a way to share files; I'd just send it t you so you can see what I am seeing.

Thanks,

Art
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Question
VBA help - yahoo finance downloader
2 3
Replies
20
Views
3K
johnnyL
J
E
  • Question
Can anyone help me get my VBA code working? I have spent tons of time but can't quite fix it.
Replies
3
Views
2K
profray
P
S
  • Question
VBA query pasting data in with new columns rather than just pasting values into existing columns?
Replies
0
Views
394
SendHalp3
S
D
  • Question
Problems Encountered When Generating VBA Excel Charts with 15-Minute Interval Data.
Replies
0
Views
142
dilshod_k
D
J
  • Question
Created Macro That Formats Sales Data through power query and keep getting errors when I try and run it
Replies
1
Views
511
Fluff
Fluff

Forum statistics

Threads
1,214,819
Messages
6,121,746
Members
449,050
Latest member
excelknuckles

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top