Help Editing Macro for Grabbing Yahoo Finance Data

[ttbuson]

I would like to update the following macro so that it becomes a user defined function like GetQuote(date,tickersymbol) where you input the date and the ticker symbol and it pulls the adjusted close price from Yahoo. Thanks for your help!

Macro courtesy of http://www.spreadsheetml.com/finance/freedownloadofstockquotes.shtml

Sub GetStock(ByVal stockSymbol As String, ByVal StartDate As Date, ByVal EndDate As Date)      Dim DownloadURL As String  Dim StartMonth, StartDay, StartYear As String   Dim EndMonth, EndDay, EndYear As String  StartMonth = Format(Month(StartDate)-1, "00")  StartDay = Format(Day(StartDate), "00")  StartYear = Format(Year(StartDate), "00")      EndMonth = Format(Month(EndDate)-1, "00")  EndDay = Format(Day(EndDate), "00")  EndYear = Format(Year(EndDate), "00")  DownloadURL="URL;http://table.finance.yahoo.com/table.csv?s="                             + stockSymbol                             + "&a=" + StartMonth + "&b="                             + StartDay + "&c=" + StartYear                             + "&d=" + EndMonth + "&e="                             + EndDay + "&f="                             + EndYear + "&g=d&ignore=.csv"      With ActiveSheet.QueryTables.Add(Connection:=DownloadURL,          Destination:=Range("$A$1"))        .FieldNames = True        .RowNumbers = False        .FillAdjacentFormulas = False        .PreserveFormatting = True        .RefreshOnFileOpen = False        .BackgroundQuery = True        .RefreshStyle = xlInsertDeleteCells        .SavePassword = False        .SaveData = True        .AdjustColumnWidth = True        .RefreshPeriod = 0        .WebSelectionType = xlSpecifiedTables        .WebFormatting = xlWebFormattingNone        .WebTables = "20"        .WebPreFormattedTextToColumns = True        .WebConsecutiveDelimitersAsOne = True        .WebSingleBlockTextImport = False        .WebDisableDateRecognition = False        .WebDisableRedirections = False        .Refresh BackgroundQuery:=False  End With  ActiveWindow.SmallScroll Down:=-12  Columns("A:A").TextToColumns Destination:=Range("A1"),_        DataType:=xlDelimited,         TextQualifier:=xlDoubleQuote,_        ConsecutiveDelimiter:=False,_        Tab:=True,_         Semicolon:=False, Comma:=True, Space:=False,_        Other:=False,_         FieldInfo:=Array(Array(1, 1), Array(2, 1),_        Array(3, 1), Array(4, 1),_        Array(5, 1), Array(6, 1), Array(7, 1))  Columns("A:F").EntireColumn.AutoFitEnd SubSub Download()   Call GetStock("YHOO", "02/01/2007", "09/05/2008")End Sub</PRE>

</PRE>

 

[ttbuson]

Sorry, I didn't realize that it wouldn't parse the code...

[FONT=Courier New][COLOR=black][COLOR=black][FONT=Courier New]Sub GetStock(ByVal stockSymbol As String, [/FONT][/COLOR]
[COLOR=black][FONT=Courier New]ByVal StartDate As Date, ByVal EndDate As Date)[/FONT][/COLOR]
 
[COLOR=black][FONT=Courier New] Dim DownloadURL As String[/FONT][/COLOR]
[COLOR=black][FONT=Courier New] Dim StartMonth, StartDay, StartYear As String [/FONT][/COLOR]
[COLOR=black][FONT=Courier New] Dim EndMonth, EndDay, EndYear As String[/FONT][/COLOR]
[COLOR=black][FONT=Courier New] StartMonth = Format(Month(StartDate)-1, "00")[/FONT][/COLOR]
[COLOR=black][FONT=Courier New] StartDay = Format(Day(StartDate), "00")[/FONT][/COLOR]
[COLOR=black][FONT=Courier New] StartYear = Format(Year(StartDate), "00")[/FONT][/COLOR]
 
[COLOR=black][FONT=Courier New] EndMonth = Format(Month(EndDate)-1, "00")[/FONT][/COLOR]
[COLOR=black][FONT=Courier New] EndDay = Format(Day(EndDate), "00")[/FONT][/COLOR]
[COLOR=black][FONT=Courier New] EndYear = Format(Year(EndDate), "00")[/FONT][/COLOR]
[COLOR=black][FONT=Courier New] DownloadURL="URL;http://table.finance.yahoo.com/table.csv[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]s=" [/FONT][/COLOR]
[COLOR=black][FONT=Courier New]                           + stockSymbol [/FONT][/COLOR]
[COLOR=black][FONT=Courier New]                           + "&a=" + StartMonth + "&b=" [/FONT][/COLOR]
[COLOR=black][FONT=Courier New]                           + StartDay + "&c=" + StartYear [/FONT][/COLOR]
[COLOR=black][FONT=Courier New]                           + "&d=" + EndMonth + "&e=" [/FONT][/COLOR]
[COLOR=black][FONT=Courier New]                           + EndDay + "&f=" [/FONT][/COLOR]
[COLOR=black][FONT=Courier New]                           + EndYear + "&g=d&ignore=.csv"[/FONT][/COLOR]
 
[COLOR=black][FONT=Courier New] With ActiveSheet.QueryTables.Add(Connection:=DownloadURL, [/FONT][/COLOR]
[COLOR=black][FONT=Courier New]        Destination:=Range("$A$1"))[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]<o:p></o:p>[/FONT][/COLOR][COLOR=black][FONT=Courier New]       .FieldNames = True[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .RowNumbers = False[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .FillAdjacentFormulas = False[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .PreserveFormatting = True[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .RefreshOnFileOpen = False[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .BackgroundQuery = True[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .RefreshStyle = xlInsertDeleteCells[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .SavePassword = False[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .SaveData = True[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .AdjustColumnWidth = True[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .RefreshPeriod = 0[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .WebSelectionType = xlSpecifiedTables[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .WebFormatting = xlWebFormattingNone[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .WebTables = "20"[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .WebPreFormattedTextToColumns = True[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .WebConsecutiveDelimitersAsOne = True[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .WebSingleBlockTextImport = False[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .WebDisableDateRecognition = False[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .WebDisableRedirections = False[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       .Refresh BackgroundQuery:=False[/FONT][/COLOR]
[COLOR=black][FONT=Courier New] End With[/FONT][/COLOR]
[COLOR=black][FONT=Courier New] ActiveWindow.SmallScroll Down:=-12[/FONT][/COLOR]
[COLOR=black][FONT=Courier New] Columns("A:A").TextToColumns Destination:=Range("A1"),_[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       DataType:=xlDelimited, [/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       TextQualifier:=xlDoubleQuote,_[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       ConsecutiveDelimiter:=False,_[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       Tab:=True,_ [/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       Semicolon:=False, Comma:=True, Space:=False,_[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       Other:=False,_ [/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       FieldInfo:=Array(Array(1, 1), Array(2, 1),_[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       Array(3, 1), Array(4, 1),_[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]       Array(5, 1), Array(6, 1), Array(7, 1))[/FONT][/COLOR]
[COLOR=black][FONT=Courier New] Columns("A:F").EntireColumn.AutoFit[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]End Sub[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]<o:p></o:p>[/FONT][/COLOR][COLOR=black][FONT=Courier New]Sub Download()[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]  Call GetStock("YHOO", "02/01/2007", "09/05/2008")[/FONT][/COLOR]
[COLOR=black][FONT=Courier New]End Sub[/FONT][/COLOR]
[/COLOR][/FONT]

 

[ttbuson]

Bump.

 

[John_w]

Try this. I've made the UDF more flexible than you asked for by adding a third argument, which is the index of the data required:

0 = Date
1 = Open
2 = High
3 = Low
4 = Close
5 = Volume
6 = Adj_Close

Therefore for Adj_Close, you would call it in a cell like this:
=GetQuote("30/11/2011","YHOO",6)

Any argument can be a cell reference like this:
=GetQuote(A2,B2,6)

The StartDate argument can be an Excel date or a date string.

The UDF can also be called from VBA like this:
volume = GetQuote("30/11/2011", "MSFT", DataIndex.iVolume)

If you don't need the flexibility of being able to retrieve different data values, just hard code the Index value in the function and delete this parameter from the function definition.

Put the code in a standard module.

Option Explicit

Public Enum DataIndex
    iDate = 0
    iOpen = 1
    iHigh = 2
    iLow = 3
    iClose = 4
    iVolume = 5
    iAdj_Close = 6
End Enum


Public Function GetQuote(StartDate As Variant, StockSymbol As String, Index As DataIndex) As String

    Dim StartMonth As String, StartDay As String, StartYear As String
    Dim EndMonth As String, EndDay As String, EndYear As String
    Dim dataArray As Variant
    Dim URL As String
    Static XMLhttp As Object
    Static previousURL As String
    Static responseCache As String
    
    StartMonth = Format(Month(StartDate) - 1, "00")
    StartDay = Format(Day(StartDate), "00")
    StartYear = Format(Year(StartDate), "00")
 
    EndMonth = Format(Month(StartDate) - 1, "00")
    EndDay = Format(Day(StartDate), "00")
    EndYear = Format(Year(StartDate), "00")
    
    URL = "http://table.finance.yahoo.com/table.csv?" _
        & "s=" & StockSymbol _
        & "&a=" & StartMonth & "&b=" & StartDay & "&c=" & StartYear _
        & "&d=" & EndMonth & "&e=" & EndDay & "&f=" & EndYear _
        & "&g=d&ignore=.csv"
    
    If URL <> previousURL Then
    
        previousURL = URL
        
        'Request new data and cache the response
        
        If XMLhttp Is Nothing Then Set XMLhttp = CreateObject("Microsoft.XMLHTTP")
        With XMLhttp
            .Open "GET", URL, False
            .send
            responseCache = .responsetext
        End With
        
    End If
    
    'Debug.Print responseCache
    dataArray = Split(Split(responseCache, vbLf)(1), ",")
    
    If Index >= LBound(dataArray) And Index <= UBound(dataArray) Then
        GetQuote = dataArray(Index)
    Else
        GetQuote = "Index argument outside data array bounds"
    End If

End Function

 

[ttbuson]

Wow, this is awesome! Thank you so much.