Excel Macro to pull historical stock market data

Macro that Automatically pulls historical stock market data from Google finance.  Input list of tickers and the macro will go pull the historical data for the specified date range.  Allows you to easily pull all historical data for multiple tickers without having to manually search and download tickers one at a time.


 

VBA Pull Stock Prices

  
Sub StockMarketDataDownload()

Application.ScreenUpdating = False
 On Error Resume Next

Dim Loc
 Dim ws, ws2, ws3 As Worksheet
 Dim EndDate, StartDate As Date
 Dim Symbol, qurl As String

'Create worksheets
 Sheets("Tickers").Select
 Set ws = ActiveSheet
 Sheets("Data").Select
 Set ws2 = ActiveSheet
 ws2.Cells.Clear

ws.Select
 StartDate = Range("B2").Value
 EndDate = Range("B3").Value

' Set Range for Loop
 Dim i As Integer
 Dim tickerEnd As Integer
 Cells(5, 1).Select
 Range(Selection, Selection.End(xlDown)).Select
 tickerEnd = Selection.Rows.Count
 tickerEnd = tickerEnd

 Dim j As Integer
 Dim idate As Integer
 Dim iclose As Integer

 'Loop through Column

For i = 2 To tickerEnd
 j = 4 + i

 iclose = i + 1
 idate = 2
 ws2.Cells.Clear
 Range("A1").Select
 ws.Select

Symbol = Cells(j, 1).Value

' ' qurl = "http://www.google.com/finance/historical?q=" & Symbol & "&output=csv"
'https://finance.google.com/finance/historical?cid=304466804484872&startdate=Aug+1%2C+2016&enddate=Oct+1%2C+2017&num=30&ei=QwXRWeCqEYiljAGdiJWoBA
'https://finance.google.com/finance/historical?q=SPY&startdate=Aug+1%2C+2016&enddate=Oct+1%2C+2017&num=30&output=csv
'https://finance.google.com/finance/historical?q=SPY&startdate=Jan+1+2016&enddate=Oct+1C+2017&num=30&output=csv

qurl = "https://finance.google.com/finance/historical?q=" _
& Symbol & "&startdate=" & Format(StartDate, "mmm") & "+" & Day(StartDate) & "+" & Year(StartDate) & _
"&enddate=" & Format(EndDate, "mmm") & "+" & Day(EndDate) & "+" & Year(EndDate) & "&num=30&output=csv"

'MsgBox qurl
 ws2.Select

Query:
 With Sheets("Data").QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("Data").Range("A1"))
 .BackgroundQuery = True
 .TablesOnlyFromHTML = False
 .Refresh BackgroundQuery:=False
 .SaveData = False
 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

 'Paste date
 Cells.Select
 Selection.Copy
 Sheets.Add After:=Sheets(Sheets.Count)
 ActiveSheet.Paste
 ActiveSheet.Name = Symbol
 Columns("A:A").Select
 Selection.ColumnWidth = 14.29
 Range("A1").Select

 Next i
Application.ScreenUpdating = True
On Error GoTo 0

ErrorHandler:

End Sub

Interested in learning new skills?