Pulling Historical stock data for multiple companies using YAHOO API in Excel

Question

I am working on a project in Excel that will give you your portfolio's value and also calculate some other useful statistics about your holdings. (Portfolio's st.dev, your portfolio's beta, etc.).

I have already used the Yahoo Finance to pull the intraday stats, (company name, last trade price, open, high, low, etc). That part was fairly straight forward, you just add the symbol and "+" in the URL and it pulls all the data for each stock.

What I am trying to do is pull the historical closing prices for all the stocks in the portfolio (unfortunately the same logic of adding the ticker symbol and "+" to the URL does not work for this).

Below is the code I have so far. On "Sheet1" is where the portfolio holdings are (Ticker symbols starting at cell A2 and going down). Sheet 2 will take the ticker symbols and display them across the top in row 2 with the url for each corresponding ticker above it in row 1.

Also the start and end dates are in sheet 2 cells C 4 and 5, respectively.

The goal is to try to get excel to get the .CSV for each ticker symbol, and record the closing price in the corresponding column.

Maybe I am going about it all wrong and there is a much easier way to get this data, but any help would be appreciated.

Thank you in advance!

Private Sub btnHistoricalData_Click()

Dim W As Worksheet: Set W = ActiveSheet
Dim DataW As Worksheet: Set DataW = ActiveWorkbook.Sheets("Sheet1") ' This is where you enter the stocks in your portfolio
Dim Last As Integer: Last = W.Range("c2").End(xlToRight).Column
Dim dataLast As Integer: dataLast = DataW.Range("A2").End(xlDown).Row

'*************************************************************************************
If Last <> dataLast Then
    W.Rows(2).Clear ' clears row if values are different so correct data can be enterred into this row
End If
'*************************************************************************************
Dim i As Integer
For i = 1 To dataLast
    W.Cells(2, 3 + i).Value = DataW.Cells(1 + i, 1).Value
Next i


Dim strtDate As Date: strtDate = W.Range("B4").Value 'Starting Date
Dim endDate As Date: endDate = W.Range("B5").Value 'End Date
 '-------------------breaks down starting month, day and year to be entered into the URL -------------------
        Dim strtMonth As String: strtMonth = Month(strtDate)
        Dim strtDay As String: strtDay = Day(strtDate)
        Dim strtYear As String: strtYear = Year(strtDate)
        Dim endMonth As String: endMonth = Month(endDate)
        Dim endDay As String: endDay = Day(endDate)
        Dim endYear As String: endYear = Year(endDate)
'-------------------------------------------------------------------------------------------------------------------------------------

Dim urlStartRange As String: urlStartRange = "&a=" & strtMonth & "&b=" & strtDay & "&c=" & strtYear ' This goes into URL for start date
Dim urlEndRange As String: urlEndRange = "&d=" & endMonth & "e=" & endDay & "&f=" & endYear & "&g=d&ignore=.csv" 'this goes into the URL as end date
'-------------------------------------------------------------------------------------------------------------------------------------

'creates a string of all symbols separated by "+"
Dim urlSymbols As String
For i = 0 To dataLast
    urlSymbols = urlSymbols & W.Cells(2, 4 + i).Value & "+"
Next i
urlSymbols = Left(urlSymbols, Len(urlSymbols) - 3) 'gets rid of extra "+" values

 Dim splitUrlSymbols As Variant: splitUrlSymbols = Split(urlSymbols, Chr(43))
 For i = 0 To dataLast - 2
       W.Cells(1, 4 + i).Value = "http://ichart.finance.yahoo.com/table.csv?s=" & splitUrlSymbols(i) & urlStartRange & urlEndRange
 Next i
   'Pulls data from YAHOO Finance --------------
Dim getHttp As New WinHttpRequest
'For i = 0 To lastdata - 2 **(eventually I need to loop this request through each column for each stock enterred)**
    getHttp.Open "GET", W.Cells(1, 5).Value, False ' *********just selected 1 cell for now****************
    getHttp.Send
    Dim httpResp As String: httpResp = getHttp.ResponseText
    Dim dataLines As Variant: dataLines = Split(httpResp, vbTab)
    Dim splitDataLines As String
    Dim dataValues As Variant
    Dim x As Integer
        For x = 0 To UBound(dataLines)
            splitDataLines = dataLines(x)

           dataValues = Split(splitDataLines, ",")

        Next x
'----------------------------------------------
   ' Next i
    MsgBox (httpResp)


End Sub

Does the code above work? If so, are you asking if there's a more efficient way to get the data? If there are errors, or it's not working as expected, what's going wrong, where? — BruceWayne
The code above works. I am asking if there is a way to get what turns out to be the third column of the .csv (closing stock price) file that is pulled, then make go to the next stock in the portfolio and pull the data (3 column of each .csv file) — D.McCloud
When the code runs it pulls a link (for example, ticker symbol ABT would look like this...ichart.finance.yahoo.com/…) — D.McCloud

D.McCloud D.McCloud · Accepted Answer · 2017-02-01T21:28:38

FIGURED IT OUT.

Just took lots of splitting and lots of loops.

Although, I'm sure it can be scripted more elegantly.

Cheers!

Dim W As Worksheet: Set W = ActiveSheet
Dim DataW As Worksheet: Set DataW = ActiveWorkbook.Sheets("Sheet1") ' This is where you enter the stocks in your portfolio
Dim Last As Integer: Last = W.Range("d2").End(xlToRight).Column
Dim dataLast As Integer: dataLast = DataW.Range("A2").End(xlDown).Row


'*************************************************************************************
If Last <> dataLast + 2 Then
    W.Rows(2).Clear ' clears row if values are different so correct data can be enterred into this row
        Dim i As Integer
For i = 1 To dataLast
    W.Cells(2, 3 + i).Value = DataW.Cells(1 + i, 1).Value
Next i
End If
'*************************************************************************************



Dim strtDate As Date: strtDate = W.Range("B4").Value 'Starting Date
Dim endDate As Date: endDate = W.Range("B5").Value 'End Date
 '-------------------breaks down starting month, day and year to be entered into the URL -------------------
        Dim strtMonth As String: strtMonth = Month(strtDate) - 1
        Dim strtDay As String: strtDay = Day(strtDate)
        Dim strtYear As String: strtYear = Year(strtDate)
        Dim endMonth As String: endMonth = Month(endDate) - 1
        Dim endDay As String: endDay = Day(endDate)
        Dim endYear As String: endYear = Year(endDate)
'-------------------------------------------------------------------------------------------------------------------------------------

Dim urlStartRange As String: urlStartRange = "&a=" & strtMonth & "&b=" & strtDay & "&c=" & strtYear ' This goes into URL for start date
Dim urlEndRange As String: urlEndRange = "&d=" & endMonth & "&e=" & endDay & "&f=" & endYear & "&g=d&ignore=.csv" 'this goes into the URL as end date
'-------------------------------------------------------------------------------------------------------------------------------------

'creates a string of all symbols separated by "+"
Dim urlSymbols As String
For i = 0 To dataLast
    urlSymbols = urlSymbols & W.Cells(2, 4 + i).Value & "+"
Next i
urlSymbols = Left(urlSymbols, Len(urlSymbols) - 3) 'gets rid of extra "+" values

 Dim splitUrlSymbols As Variant: splitUrlSymbols = Split(urlSymbols, Chr(43))
 For i = 0 To dataLast - 2
       W.Cells(1, 4 + i).Value = "http://ichart.finance.yahoo.com/table.csv?s=" & splitUrlSymbols(i) & urlStartRange & urlEndRange
 Next i
   'Pulls data from YAHOO Finance --------------
For Z = 0 To dataLast - 2
Dim getHttp As New WinHttpRequest

    getHttp.Open "GET", W.Cells(1, Z + 4).Value, False ' *********just selected 1 cell for now****************
    getHttp.Send
    Dim httpResp As String: httpResp = getHttp.ResponseText
    Dim dataLines As Variant: dataLines = Split(httpResp, vbLf)
    Dim closeValue As String
    Dim x As Integer
        For x = 1 To UBound(dataLines) - 4: Debug.Print dataLines(2)
            closeValue = dataLines(x)
            Dim adjClose As Variant: adjClose = Split(closeValue, ",")
                 If InStr(closeValue, ",") > 0 Then
            W.Cells(2 + x, Z + 4).Value = adjClose(6)
                End If
        Next x
    Dim y As Integer
    'Dim adjClose As Variant: adjClose = Split(closeValue, ",")



Next Z

Pulling Historical stock data for multiple companies using YAHOO API in Excel

1 Answers