Stock Ticker Macro

magitekkx

New Member
Joined
Jan 22, 2014
Messages
27
Hi all,

I have seen a few threads over the past few months asking this same question, but haven't come across an answer so I thought I would ask here:

I used to run a macro/function called StockQuote which was based off of Yahoo Finance's API that would allow me to pull in a stock's price after entering in the ticker and a historical date. Of course, Yahoo recently modified their API and so this function stopped working one day and ever since.

I was wondering if anyone has had success with a simple macro that allows you to pull in a stock price based on ticker and date, since the change to Yahoo. I am running Excel 2010 so don't have the ability to pull in quotes the way Excel 2016 can. That's really all I am looking for, but have been unable to find a solution anywhere on the web or on this message board. If anyone could help, that would be awesome!

Thanks!
 
"This worked, and is awesome... thank you so much..."

You're very welcome.

Something odd about QueryTables - every time you add one it inserts a column. Couldn't find a resolution for this so that's why the first code iteration included a couple of loops to reformat the data. Even so, the additional columns were enough to mess with your Index/Match formulas.

This next approach copies each QueryTable from the Data sheet as it's added to a FinalData sheet so there are no inserted columns. The code also cleans up the extraneous named ranges and connections that QueryTables create.

Notes:
Please name the sheet with the ticker symbols - SymbolList
Please add a sheet and name it - FinalData

Code:
Sub GetData3()
Dim DataSheet As Worksheet
Dim EndDate As Date
Dim StartDate As Date
Dim tick As Range, ticker As Range
Dim qurl As String
Dim LastRow As Long, LastColumn As Long, i As Long, j As Long, k As Long
Dim arr As Variant
Dim nName As Name

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Sheets("Data").Cells.Clear
Sheets("FinalData").Columns("A:G").Clear
Set DataSheet = Sheets("SymbolList")
DataSheet.Activate

StartDate = DataSheet.Range("startDate").Value
EndDate = DataSheet.Range("endDate").Value
Set ticker = DataSheet.Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)
Sheets("Data").Range("a1").CurrentRegion.ClearContents

'''' Loop through each ticker symbol and retrieve data
i = 1
For Each tick In ticker
    qurl = "http://finance.google.com/finance/historical?q=" & tick.Value
    qurl = qurl & "&startdate=" & MonthName(Month(StartDate), True) & _
           "+" & Day(StartDate) & "+" & Year(StartDate) & _
           "&enddate=" & MonthName(Month(EndDate), True) & _
           "+" & Day(EndDate) & "+" & Year(EndDate) & "&output=csv"
    
QueryQuote:
    With Sheets("Data").QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("Data").Cells(1, 1))
        .BackgroundQuery = True
        .TablesOnlyFromHTML = False
        .RefreshStyle = xlOverwriteCells
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With

    i = i + 1
    Sheets("Data").Range("A2").Copy
    Sheets("FinalData").Cells(i, 2).PasteSpecial xlPasteValues
    Sheets("Data").UsedRange.ClearContents
Next tick

'''' Delete extraneous named ranges and connections
For Each nName In Application.ActiveWorkbook.Names
    If InStr(nName.Name, "ExternalData") > 0 Then nName.Delete
Next nName
On Error Resume Next
For k = 1 To ActiveWorkbook.Connections.Count
    ActiveWorkbook.Connections(k).Delete
Next k
On Error GoTo 0

'''' Format data: TextToColumns
Sheets("FinalData").Range("B2").CurrentRegion.TextToColumns Destination:=Sheets("FinalData").Range("B2"), DataType:=xlDelimited, _
                                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                                    Semicolon:=False, Comma:=True, Space:=False, other:=False
'''' Add headers to Row1 and ticker symbols to Column1
arr = Array("Symbol", "Date", "Open", "High", "Low", "Close", "Volume")
Sheets("FinalData").Range("A1:G1") = arr
DataSheet.Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row).Copy Destination:=Sheets("FinalData").Range("A2")
Sheets("FinalData").Columns("A:G").ColumnWidth = 12

LastRow = Sheets("FinalData").UsedRange.Row - 2 + Sheets("FinalData").UsedRange.Rows.Count
Sheets("FinalData").Sort.SortFields.Add Key:=Range("A2:A" & LastRow), _
                                   SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With Sheets("FinalData").Sort
    .SetRange Range("A1:G" & LastRow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    .SortFields.Clear
End With
Application.Goto Sheets("FinalData").Range("A1")
MsgBox "Done!"
End Sub
 
Upvote 0

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Forum statistics

Threads
1,223,908
Messages
6,175,306
Members
452,633
Latest member
DougMo

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