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!

 

[magitekkx]

Ok, so I've done some more digging, and I found some code that allows you to import a ticker from Google's API. The issue is it only allows you to bring in one symbol! Is there anyone out there that can reprogram this to allow for multiple tickers? Here is the code:

Sub GetData()
Dim DataSheet As Worksheet
Dim EndDate As Date
Dim StartDate As Date
Dim Symbol As String
Dim qurl As String
Dim nQuery As Name
Dim LastRow As Integer


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


Sheets("Data").Cells.Clear


Set DataSheet = ActiveSheet


StartDate = DataSheet.Range("startDate").Value
EndDate = DataSheet.Range("endDate").Value
Symbol = DataSheet.Range("ticker").Value
Sheets("Data").Range("a1").CurrentRegion.ClearContents




qurl = "http://finance.google.com/finance/historical?q=" & Symbol
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").Range("a1"))
    .BackgroundQuery = True
    .TablesOnlyFromHTML = False
    .Refresh BackgroundQuery:=False
    .SaveData = True
End With


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


Sheets("Data").Columns("A:G").ColumnWidth = 12


LastRow = Sheets("Data").UsedRange.Row - 2 + Sheets("Data").UsedRange.Rows.Count


Sheets("Data").Sort.SortFields.Add Key:=Range("A2:A" & LastRow), _
                                   SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal


With Sheets("Data").Sort
    .SetRange Range("A1:G" & LastRow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    .SortFields.Clear
End With


End Sub

 

[tonyyy]

Sheet1

*	A	B	C
StartDate	EndDate	Symbol
aapl
*	*	ge
*	*	swks
*	*	amgn

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:78px;"><col style="width:78px;"><col style="width:78px;"></colgroup><tbody>
[TD="bgcolor: #cacaca, align: center"]1[/TD]

[TD="bgcolor: #cacaca, align: center"]2[/TD]
[TD="align: right"]6/23/2017[/TD]
[TD="align: right"]6/23/2017[/TD]

[TD="bgcolor: #cacaca, align: center"]3[/TD]

[TD="bgcolor: #cacaca, align: center"]4[/TD]

[TD="bgcolor: #cacaca, align: center"]5[/TD]

</tbody>

Excel tables to the web >> Excel Jeanie HTML 4


Assumes your ticker symbol(s) are in Column C starting in C2.

Sub GetData2()
Dim DataSheet As Worksheet
Dim EndDate As Date
Dim StartDate As Date
Dim tick As Range, ticker As Range
Dim qurl As String
Dim nQuery As Name
Dim LastRow As Long, LastColumn As Long, i As Long, j As Long
Dim arr As Variant

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

Sheets("Data").Cells.Clear

Set DataSheet = ActiveSheet

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

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(i, 1))
        .BackgroundQuery = True
        .TablesOnlyFromHTML = False
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With
    i = i + 2
Next tick

LastRow = Sheets("Data").Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
LastColumn = Sheets("Data").Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
For i = LastColumn - 1 To 1 Step -1
    For j = LastRow - 1 To 2 Step -1
        If Sheets("Data").Cells(j, i).Value = "" Then
            Sheets("Data").Cells(j, i).Delete Shift:=xlToLeft
        ElseIf InStr(Sheets("Data").Cells(j, i).Value, "Volume") > 0 Then
            Sheets("Data").Rows(j).Delete
        End If
    Next j
Next i
    
Sheets("Data").Range("a1").CurrentRegion.TextToColumns Destination:=Sheets("Data").Range("a1"), DataType:=xlDelimited, _
                                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                    Semicolon:=False, Comma:=True, Space:=False, other:=False

arr = Array("Date", "Open", "High", "Low", "Close", "Volume","Symbol")
Sheets("Data").Range("A1:G1") = arr
DataSheet.Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row).Copy Destination:=Sheets("Data").Range("G2")
Sheets("Data").Columns("A:G").ColumnWidth = 12

LastRow = Sheets("Data").UsedRange.Row - 2 + Sheets("Data").UsedRange.Rows.Count

Sheets("Data").Sort.SortFields.Add Key:=Range("A2:A" & LastRow), _
                                   SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

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

Cheers,

tonyyy

 

[Logit]

.
Yahoo added "Download" to the URL.
Here's an example: http:'//download.finance.yahoo.com/d/quotes.csv?s=AKO-A+AKO-A+AKO-B+AXL+BF-A+BF-B+BRK-A+BRK-B+CRD-A+VTL&f=l1a2nxj1e9e7rs7i

(REMOVE THE APOSTROPHE, 6 SPACES FROM LEFT) I had to put that in there so the entire URL would display correctly here.


Here is a link to download a sample workbook that works: https://www.amazon.com/clouddrive/s...gRzMvhw0zfFU4D7LtV?ref_=cd_ph_share_link_copy

 

[igold]

@Logit and magitekkx

The Yahoo Stock Quoting is still functioning at the URL Logit provided. It is the Historical quoting that Yahoo has messed with please see this thread...

https://www.mrexcel.com/forum/excel-questions/1005785-yahoo-finance-api-stock-quotes-changed.html

 

[magitekkx]

Thank you all for your advice. Each of you were extremely helpful.

Tonyyy I am working on a new workbook using your code.

Logit and igold thank you both for the helpful info.

 

[magitekkx]

Hi tonyyy, I must be doing something wrong, because I entered in the same info you did in A1 through C5, and pasted your code in. I get a "Subscript out of range" error when I try running your macro.

Does the sheet need to be named something special? Do I need to name any ranges? Any ideas?

Thanks.

 

[tonyyy]

"Subscript out of range" error...

It would be helpful to know which code line is highlighted when the error is generated. That said...

Cell A2 is a named range - startDate
Cell B2 is a named range - endDate
You'll also need another sheet named - Data

The sheet with the stock symbols should be active/displayed when initiating the macro.

 

[welshgasman]

I use a sheet I found on the net.
A comment has Copyright 2010 by Daniel Ferry, Excel Hero

If you PM me with your email address I'll send you a copy.
I use it each day.

 

[magitekkx]

This worked, and is awesome. Can I ask for one more quick item? I will basically be running this macro once a day at the end of the day, to populate a bunch of tickers (~100) in my master portfolio sheet. When the macro is run, it creates a table in a new tab called data. One thing I noticed is that if I try to do an index match function, it works, but then if I run the macro again, I have to manually type in the index match range again, because the original range seems to be shifted over a few cells.

Is there a way to make the chart that gets pasted into the Data tab always stay in columns A-H, so that I can create an index match function that doesn't have to be manually re-entered in everyday? Alternatively, if we change the order of the columns in the pasted table so that the stock symbol is to the left of the table, I could then use a vlookup instead of index / match. However, I still think the issue with the table shifting to the right each time the macro is run would occur in that instance as well.

Even if this can't be adjusted further, this is exactly what I needed, so thank you so much tonyyy!!!!