Philadelphia Reflections

Get Historical Stock Data in Excel (single date; from Yahoo Finance)

This VBA function returns data for a stock on a single specific date, using Yahoo Finance's CSV data.

Function GetHistoricalData(Symbol As String, _
                           QuoteDate As Date, _
                  Optional QuoteType As String = "AdjClose") As Double

    ' Returns stock data for "Symbol" on "QuoteDate" using Yahoo Finance
    '
    ' The choices for "QuoteType" are
    '   Open
    '   High
    '   Low
    '   Close
    '   Volume
    '   Adj Close or AdjClose (Default)
    '
    ' ... and these calculated values:
    '   MAX (maximum of Open, High, Low, Close, AdjClose)
    '   MIN (minimum of Open, High, Low, Close, AdjClose)
    '   AVG (average of High, Low)
    '
    ' for example
    '    =GetHistoricalData("BRK.A", DATEVALUE("2/26/2012"))
    ' returns
    '    120,350.00
    '
    ' (you'd be more likely to refer to a cell with a date in it)
    '
    ' Thanks to Peter Urbani at https://www.wilmott.com/messageview.cfm?catid=10&threadid=25730
    '
    ' Note: I figure out if you gave me a weekend and I look for the previous Friday
    '       but if you give me a weekday holiday, I will produce unpredictable results
    '       give me "02/30/1998" and I'll give you #VALUE
    
    
    ' If you want current data to see the following:
    '
    ' https://www.philadelphia-reflections.com/blog/2392.htm
    ' https://www.philadelphia-reflections.com/blog/2385.htm
    
    ' Before you start, read this:
    ' https://stackoverflow.com/questions/11245733/declaring-early-bound-msxml-object-throws-an-error-in-vba
    
    Dim URL As String
    
    Dim StartMonth As Integer, _
        EndMonth As Integer, _
        StartDay As Integer, _
        EndDay As Integer, _
        StartYear As Integer, _
        EndYear As Integer, _
        DateInt As Integer
    
    Dim Parts() As String

    ' if date entered is a weekend, find the previous Friday
    DateInt = Weekday(QuoteDate)
    If (DateInt = 1) Then      ' Sunday
        QuoteDate = DateAdd("d", -2, QuoteDate)
    ElseIf (DateInt = 7) Then  ' Saturday
        QuoteDate = DateAdd("d", -1, QuoteDate)
    End If

    ' note that I pick a single date
    StartYear = year(QuoteDate)
    EndYear = StartYear

    StartMonth = month(QuoteDate)
    EndMonth = StartMonth

    StartDay = day(QuoteDate)
    EndDay = StartDay

    ' Yahoo Finance URL
    URL = "https://ichart.finance.yahoo.com/table.csv?s=" & Symbol & _
           IIf(StartMonth = 0, "&a=0", "&a=" & (StartMonth - 1)) & _
           IIf(StartDay = 0, "&b=1", "&b=" & StartDay) & _
           IIf(StartYear = 0, "&c=" & EndYear, "&c=" & StartYear) & _
           IIf(EndMonth = 0, "", "&d=" & (EndMonth - 1)) & _
           IIf(EndDay = 0, "", "&e=" & EndDay) & _
           IIf(EndYear = 0, "", "&f=" & EndYear) & _
           "&g=d" & _
           "&ignore=.csv"


    ' Send the request URL
    Dim HTTP As New XMLHTTP
    HTTP.Open "GET", URL, False
    HTTP.Send
    
    If HTTP.Status <> "200" Then
        MsgBox "request error: " & HTTP.Status
        Exit Function
    End If
    
    ' split the returned comma-delimited string at the commas
    Parts = Split(HTTP.responseText, ",")
    
    Select Case LCase(QuoteType)
        Case "open"
            GetHistoricalData = Val(Parts(7))
            Exit Function
        Case "high"
            GetHistoricalData = Val(Parts(8))
            Exit Function
        Case "low"
            GetHistoricalData = Val(Parts(9))
            Exit Function
        Case "close"
            GetHistoricalData = Val(Parts(10))
            Exit Function
        Case "volume"
            GetHistoricalData = Val(Parts(11))
            Exit Function
        Case "adjclose", "adj close"
            GetHistoricalData = Val(Parts(12))
            Exit Function
        Case "max"
            GetHistoricalData = Application.Max(Val(Parts(7)), Val(Parts(8)), Val(Parts(9)), Val(Parts(10)), Val(Parts(12)))
            Exit Function
        Case "min"
            GetHistoricalData = Application.Min(Val(Parts(7)), Val(Parts(8)), Val(Parts(9)), Val(Parts(10)), Val(Parts(12)))
            Exit Function
        Case "avg"
            GetHistoricalData = Application.Average(Val(Parts(8)), Val(Parts(9)))
            Exit Function
        Case Else
            MsgBox QuoteType & " invalid QuoteType for GetHistoricalData function"
            Exit Function
    End Select
    
End Function

How to install an Excel macro

1. In a spreadsheet press Alt+F11
2. Insert > Module
3. Copy the code on this page and paste it into your new module
4. Tools > References > Microsoft XML v6 per the picture below
5. Switch back to your spreadsheet (x out of the VBA screen if you want)

Thanks to declaring early bound msxml object throws an error in vba for both the clue and the picture

My thanks to Encode / Decode HTML Entities

Originally published: Saturday, December 22, 2012; most-recently modified: Monday, May 20, 2019