VBA - Yahoo Finance Historical Price Pull

uwreedb3

New Member
Joined
Aug 27, 2013
Messages
14
I'm pretty new at VBA and I've looked through a few threads online but haven't quite found anything that works the way I want.

The idea is that the user will paste data onto sheet 1, such as ticker symbol, date, account number, and price paid etc. I would like to create a macro assigned to a button that will auto populate sheet 2 with the following columns:

Symbol(pulled from sheet 1 Column F), TradePrice (pulled from sheet 1 Column N), TradeDate (pulled from sheet 1 column L), Low(pulled from yahoo finance for the given trade date), High(pulled from yahoo finance for the given trade date).


Thanks for your thoughts!
 
As a side, I found the below code at VBA Macros Provide Yahoo Stock Quote Downloads in Excel 2007 - CodeProject
I know this doesn't provide exactly what I want but I was hoping to get it working and then worry about making the adjustments

' for all sequential symbols in A2 and on down.
'
' manageCalcStatus = TRUE if we should turn Autocalc off then restore, or FALSE if caller does it
'
Sub UpdatePriceData(Optional manageCalcStatus As Boolean = True)
Dim stockXml As MSXML2.IXMLDOMNode
Dim stockData(5) As Double ' Open, High, Low, Volume
Dim stockDate As Date ' Last Trade Date
Dim stockTime As Date ' Last Trade time

sbState = Application.DisplayStatusBar ' save current state
Application.DisplayStatusBar = True ' take over status bar
Application.StatusBar = "Preparing quote request..."

If manageCalcStatus Then
appCalcStatus = Application.Calculation
Application.Calculation = xlCalculationManual
End If

' Activate the sheet and get to the last row
Sheets("Price Data").Select
Range("A2").Select
Selection.End(xlDown).Select

' Capture the row number, then start the loop
iRowLast = ActiveCell.Row
For i = 2 To iRowLast
' For each stock row, get the XML data for the stock and write it to the row
Range("A" & i).Select
Application.StatusBar = "Get quote for: " & ActiveCell.Value
Set stockXml = GetQuoteXmlFromWeb(ActiveCell.Value)
' test for Nothing
If stockXml Is Nothing Then
' Could not find it -- all 0's and set date to today
For n = 0 To UBound(stockData) - 1
stockData(n) = 0
Next n
stockDate = Date
stockTime = 0
Else
' Got the data... get each piece
stockData(0) = Val(GetQuoteFromXml(stockXml, "Open"))
stockData(1) = Val(GetQuoteFromXml(stockXml, "DaysHigh"))
stockData(2) = Val(GetQuoteFromXml(stockXml, "DaysLow"))
stockData(3) = Val(GetQuoteFromXml(stockXml, "LastTradePriceOnly"))
stockData(4) = Val(GetQuoteFromXml(stockXml, "Volume"))

stockDate = CDate(GetQuoteFromXml(stockXml, "LastTradeDate"))
stockTime = TimeValue(GetQuoteFromXml(stockXml, "LastTradeTime"))
' Resets status bar text if GetQUoteFromXml was tweaking it
Application.StatusBar = "Get quote for: " & ActiveCell.Value
End If

' Now assign values out to cells the current row (B to F, then G)
For n = 0 To UBound(stockData) - 1
Range(Chr(Asc("B") + n) & i).Value = stockData(n)
Next n
Range(Chr(Asc("B") + UBound(stockData)) & i).Value = stockDate
Range(Chr(Asc("B") + 1 + UBound(stockData)) & i).Value = stockTime
Next i

If manageCalcStatus Then
Application.StatusBar = "Resetting calculation state..."
Application.Calculation = appCalcStatus ' restore calculation mode too
End If
Application.StatusBar = False ' this RESTORES default text to the status bar... honest!
Application.DisplayStatusBar = sbState ' return control to origina state


End Sub
 
Upvote 0
Actually that video was very helpful, thanks!
I've got the data pull to work for the current date, the only thing I'm still having with is historical data. I'm using the same setup as that video (same code and I'm actually looking for the same headers so that works out), but I want to have it read a date from column A and then find that data on the given date.
 
Upvote 0
So I was able to get the pull to work for current date only. I made a few changes to the code but they didn't seem to work and now I'm somewhat lost. Below is the code if anyone has any thoughts. I want to reference a date in column H and pull the data for that day. Thanks!

Private Sub BTNrefresh_Click()
Application.ScreenUpdating = False

DataPaste
TradeDate

'Pulls the stock symbols up until the last row regardless of the amount of entries
Dim W As Worksheet: Set W = ActiveSheet
Dim Last As Integer: Last = W.Range("A10000").End(xlUp).Row


'Checks to see if there is actually data
If Last = 1 Then Exit Sub


'Cycle through and set up symbol and date variables
Dim Symbols As String
Dim StartDate As Date
Dim EndDate As Date
Dim i As Integer
For i = 2 To Last
Symbols = Symbols & W.Range("A" & i).Value & "+"
Next i
Symbols = Left(Symbols, Len(Symbols) - 1)

For i = 2 To Last
StartDate = StartDate & W.Range("H" & i).Value & "+"
Next i
StartDate = Left(StartDate, Len(StartDate) - 1)

For i = 2 To Last
EndDate = EndDate & W.Range("H" & i).Value & "+"
Next i
EndDate = Left(EndDate, Len(EndDate) - 1)

Dim URL As String: URL = "real-chart.finance.yahoo.com/table.csv?s" & Symbols & "&f=snl1hg"
Dim Http As New WinHttpRequest
Http.Open "GET", URL, False
Http.Send

Dim Resp As String: Resp = Http.ResponseText
Dim Lines As Variant: Lines = Split(Resp, vbNewLine)
Dim sLine As String
Dim Values As Variant
For i = 0 To UBound(Lines)
sLine = Lines(i)

If InStr(sLine, ",") > 0 Then
Values = Split(sLine, ",")
W.Cells(i + 2, 2).Value = Split(Split(sLine, Chr(34) & "," & Chr(34))(1), Chr(34))(0)
W.Cells(i + 2, 3).Value = Values(UBound(Values) - 2)
W.Cells(i + 2, 4).Value = Values(UBound(Values) - 1)
W.Cells(i + 2, 5).Value = Values(UBound(Values))

End If
Next i
W.Cells.Columns.AutoFit

Application.ScreenUpdating = True

End Sub
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top