Stock Ticker Macro

[magitekkx]

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!

 

[tonyyy]

"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

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