Option Explicit
Public Const firstTickerRow As Integer = 13
Sub DownloadData()
Dim frequency As String
Dim lastRow As Integer
Dim lastErrorRow As Integer
Dim lastSuccessRow As Integer
Dim stockTicker As String
Dim numStockErrors As Integer
Dim numStockSuccess As Integer
Dim startDate As String
Dim endDate As String
Dim ticker As Integer
Dim crumb As String
Dim cookie As String
Dim validCookieCrumb As Boolean
Dim sortOrderComboBox As Shape
numStockErrors = 0
numStockSuccess = 0
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lastErrorRow = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
lastSuccessRow = ActiveSheet.Cells(Rows.Count, "L").End(xlUp).Row
ClearErrorList lastErrorRow
ClearSuccessList lastSuccessRow
lastRow = ActiveSheet.Cells(Rows.Count, "a").End(xlUp).Row
frequency = Worksheets("Parameters").Range("b7")
startDate = (Sheets("Parameters").Range("startDate") - DateValue("January 1, 1970")) * 86400
endDate = (Sheets("Parameters").Range("endDate") - DateValue("January 1, 1970")) * 86400
If Worksheets("Parameters").Range("frequency") = "d" Then
frequency = "1d"
ElseIf Worksheets("Parameters").Range("frequency") = "w" Then
frequency = "1wk"
ElseIf Worksheets("Parameters").Range("frequency") = "m" Then
frequency = "1mo"
End If
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Parameters" And ws.Name <> "About" Then ws.Delete
Next
Call getCookieCrumb(crumb, cookie, validCookieCrumb)
If validCookieCrumb = False Then
GoTo ErrorHandler:
End If
For ticker = firstTickerRow To lastRow
stockTicker = Worksheets("Parameters").Range("$a$" & ticker)
If stockTicker = "" Then
GoTo NextIteration
End If
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = stockTicker
Cells(1, 1) = "Stock Quotes for " & stockTicker
Call getYahooFinanceData(stockTicker, startDate, endDate, frequency, cookie, crumb)
lastRow = Sheets(stockTicker).UsedRange.Row - 2 + Sheets(stockTicker).UsedRange.Rows.Count
If lastRow < 3 Then
Sheets(stockTicker).Delete
numStockErrors = numStockErrors + 1
ErrorList stockTicker, numStockErrors
GoTo NextIteration
Else
numStockSuccess = numStockSuccess + 1
If Left(stockTicker, 1) = "^" Then
SuccessList Replace(stockTicker, "^", ""), numStockSuccess
Else
SuccessList stockTicker, numStockSuccess
End If
End If
Range("a3:a" & lastRow).NumberFormat = "yyyy-mm-dd;@"
Set sortOrderComboBox = Sheets("Parameters").Shapes("SortOrderDropDown")
With sortOrderComboBox.ControlFormat
If .List(.Value) = "Oldest First" Then
Call SortByDate(stockTicker, "oldest")
ElseIf .List(.Value) = "Newest First" Then
Call SortByDate(stockTicker, "newest")
End If
End With
If Left(stockTicker, 1) = "^" Then
ActiveSheet.Name = Replace(stockTicker, "^", "")
Else
ActiveSheet.Name = stockTicker
End If
If InStr(stockTicker, "-") > 0 Then
ActiveSheet.Name = Replace(stockTicker, "-", "")
End If
NextIteration:
Next ticker
If Sheets("Parameters").Shapes("WriteToCSVCheckBox").ControlFormat.Value = xlOn Then
On Error GoTo ErrorHandler:
Call CopyToCSV
End If
If Sheets("Parameters").Shapes("CollateDataCheckBox").ControlFormat.Value = xlOn Then
On Error GoTo ErrorHandler:
Call CollateData
End If
ErrorHandler:
Worksheets("Parameters").Select
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub SortByDate(ticker As String, order As String)
Dim firstRow As Integer
Dim lastRow As Integer
Dim sortType As Variant
lastRow = Sheets(ticker).UsedRange.Rows.Count
firstRow = 2
If order = "oldest" Then
sortType = xlAscending
Else
sortType = xlDescending
End If
Worksheets(ticker).Sort.SortFields.Clear
Worksheets(ticker).Sort.SortFields.Add Key:=Sheets(ticker).Range("A" & firstRow & ":A" & lastRow), _
SortOn:=xlSortOnValues, order:=sortType, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(ticker).Sort
.SetRange Range("A" & firstRow & ":G" & lastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub CollateData()
Dim ws As Worksheet
Dim i As Integer
Dim maxRow As Integer
Dim maxTickerWS As Worksheet
maxRow = 0
For Each ws In Worksheets
If ws.Name <> "Parameters" Then
If ws.UsedRange.Rows.Count > maxRow Then
maxRow = ws.UsedRange.Rows.Count
Set maxTickerWS = ws
End If
End If
Next
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Open Price"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "High Price"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Low Price"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Close Price"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Adjusted Close Price"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Trading Volume"
i = 1
maxTickerWS.Range("A2", "B" & maxRow).Copy Destination:=Sheets("Open Price").Cells(1, i)
Sheets("Open Price").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("High Price").Cells(1, i)
maxTickerWS.Range("c2", "c" & maxRow).Copy Destination:=Sheets("High Price").Cells(1, i + 1)
Sheets("High Price").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Low Price").Cells(1, i)
maxTickerWS.Range("d2", "d" & maxRow).Copy Destination:=Sheets("Low Price").Cells(1, i + 1)
Sheets("Low Price").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Close Price").Cells(1, i)
maxTickerWS.Range("e2", "e" & maxRow).Copy Destination:=Sheets("Close Price").Cells(1, i + 1)
Sheets("Close Price").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Adjusted Close Price").Cells(1, i)
maxTickerWS.Range("f2", "f" & maxRow).Copy Destination:=Sheets("Adjusted Close Price").Cells(1, i + 1)
Sheets("Trading Volume").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Trading Volume").Cells(1, i)
maxTickerWS.Range("g2", "g" & maxRow).Copy Destination:=Sheets("Trading Volume").Cells(1, i + 1)
Sheets("Adjusted Close Price").Cells(1, i + 1) = maxTickerWS.Name
i = i + 2
For Each ws In Worksheets
If ws.Name <> "Stacked Data" And ws.Name <> "Parameters" And ws.Name <> "About" And ws.Name <> maxTickerWS.Name And ws.Name <> "Open Price" And ws.Name <> "High Price" And ws.Name <> "Low Price" And ws.Name <> "Close Price" And ws.Name <> "Trading Volume" And ws.Name <> "Adjusted Close Price" Then
Sheets("Open Price").Cells(1, i) = ws.Name
Sheets("Open Price").Range(Sheets("Open Price").Cells(2, i), Sheets("Open Price").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",2,0)"
Sheets("High Price").Cells(1, i) = ws.Name
Sheets("High Price").Range(Sheets("High Price").Cells(2, i), Sheets("High Price").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",3,0)"
Sheets("Low Price").Cells(1, i) = ws.Name
Sheets("Low Price").Range(Sheets("Low Price").Cells(2, i), Sheets("Low Price").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",4,0)"
Sheets("Close Price").Cells(1, i) = ws.Name
Sheets("Close Price").Range(Sheets("Close Price").Cells(2, i), Sheets("Close Price").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",5,0)"
Sheets("Adjusted Close Price").Cells(1, i) = ws.Name
Sheets("Adjusted Close Price").Range(Sheets("Adjusted Close Price").Cells(2, i), Sheets("Adjusted Close Price").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",6,0)"
Sheets("Trading Volume").Cells(1, i) = ws.Name
Sheets("Trading Volume").Range(Sheets("Trading Volume").Cells(2, i), Sheets("Trading Volume").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",7,0)"
i = i + 1
End If
Next
On Error Resume Next
Sheets("Open Price").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Close Price").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("High Price").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Low Price").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Trading Volume").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Adjusted Close Price").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Open Price").UsedRange.Value = Sheets("Open Price").UsedRange.Value
Sheets("Close Price").UsedRange.Value = Sheets("Close Price").UsedRange.Value
Sheets("High Price").UsedRange.Value = Sheets("High Price").UsedRange.Value
Sheets("Low Price").UsedRange.Value = Sheets("Low Price").UsedRange.Value
Sheets("Trading Volume").UsedRange.Value = Sheets("Trading Volume").UsedRange.Value
Sheets("Adjusted Close Price").UsedRange.Value = Sheets("Adjusted Close Price").UsedRange.Value
On Error GoTo 0
Sheets("Open Price").Columns("A:A").EntireColumn.AutoFit
Sheets("High Price").Columns("A:A").EntireColumn.AutoFit
Sheets("Low Price").Columns("A:A").EntireColumn.AutoFit
Sheets("Close Price").Columns("A:A").EntireColumn.AutoFit
Sheets("Trading Volume").Columns("A:A").EntireColumn.AutoFit
Sheets("Adjusted Close Price").Columns("A:A").EntireColumn.AutoFit
End Sub
Sub SuccessList(ByVal stockTicker As String, ByVal numStockSuccess As Integer)
Sheets("Parameters").Range("L" & 10 + numStockSuccess) = stockTicker
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeTop).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeRight).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideHorizontal).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalUp).LineStyle = xlNone
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideHorizontal).LineStyle = xlNone
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End Sub
Sub ErrorList(ByVal stockTicker As String, ByVal numStockErrors As Integer)
Sheets("Parameters").Range("J" & 10 + numStockErrors) = stockTicker
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeTop).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeRight).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideHorizontal).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalUp).LineStyle = xlNone
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideHorizontal).LineStyle = xlNone
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End Sub
Sub ClearErrorList(ByVal lastErrorRow As Integer)
If lastErrorRow > 10 Then
Worksheets("Parameters").Range("J11:J" & lastErrorRow).Clear
With Sheets("Parameters").Range("J10").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
End If
End Sub
Sub ClearSuccessList(ByVal lastSuccessRow As Integer)
If lastSuccessRow > 10 Then
Worksheets("Parameters").Range("L11:L" & lastSuccessRow).Clear
With Sheets("Parameters").Range("L10").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
End If
End Sub
Sub CopyToCSV()
Dim MyPath As String
Dim MyFileName As String
Dim dateFrom As Date
Dim dateTo As Date
Dim frequency As String
Dim ws As Worksheet
Dim ticker As String
dateFrom = Worksheets("Parameters").Range("$b$5")
dateTo = Worksheets("Parameters").Range("$b$6")
frequency = Worksheets("Parameters").Range("$b$7")
MyPath = Worksheets("Parameters").Range("$b$8")
For Each ws In Worksheets
If ws.Name <> "Parameters" And ws.Name <> "About" Then
ticker = ws.Name
MyFileName = ticker & " " & Format(dateFrom, "dd-mm-yyyy") & " - " & Format(dateTo, "dd-mm-yyyy") & " " & frequency
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
Sheets(ticker).Copy
With ActiveWorkbook
.SaveAs Filename:= _
MyPath & MyFileName, _
FileFormat:=xlCSV, _
CreateBackup:=False
.Close False
End With
End If
Next
End Sub
Sub getCookieCrumb(crumb As String, cookie As String, validCookieCrumb As Boolean)
Dim i As Integer
Dim str As String
Dim crumbStartPos As Long
Dim crumbEndPos As Long
Dim objRequest
validCookieCrumb = False
For i = 0 To 5
Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
With objRequest
.Open "GET", "https://finance.yahoo.com/lookup?s=bananas", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.send
.waitForResponse (10)
cookie = Split(.getResponseHeader("Set-Cookie"), ";")(0)
crumbStartPos = InStrRev(.ResponseText, """crumb"":""") + 9
crumbEndPos = crumbStartPos + 11
crumb = Mid(.ResponseText, crumbStartPos, crumbEndPos - crumbStartPos)
End With
If Len(crumb) = 11 Then
validCookieCrumb = True
Exit For
End If:
Next i
End Sub
Sub getYahooFinanceData(stockTicker As String, startDate As String, endDate As String, frequency As String, cookie As String, crumb As String)
Dim resultFromYahoo As String
Dim objRequest
Dim csv_rows() As String
Dim resultArray As Variant
Dim nColumns As Integer
Dim iRows As Integer
Dim CSV_Fields As Variant
Dim iCols As Integer
Dim tickerURL As String
tickerURL = "https://query1.finance.yahoo.com/v7/finance/download/" & stockTicker & _
"?period1=" & startDate & _
"&period2=" & endDate & _
"&interval=" & frequency & "&events=history" & "&crumb=" & crumb
Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
With objRequest
.Open "GET", tickerURL, False
.setRequestHeader "Cookie", cookie
.send
.waitForResponse
resultFromYahoo = .ResponseText
End With
nColumns = 6
csv_rows() = Split(resultFromYahoo, Chr(10))
ReDim resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant
For iRows = LBound(csv_rows) To UBound(csv_rows)
CSV_Fields = Split(csv_rows(iRows), ",")
If UBound(CSV_Fields) > nColumns Then
nColumns = UBound(CSV_Fields)
ReDim Preserve resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant
End If
For iCols = LBound(CSV_Fields) To UBound(CSV_Fields)
If IsNumeric(CSV_Fields(iCols)) Then
resultArray(iRows, iCols) = Val(CSV_Fields(iCols))
ElseIf IsDate(CSV_Fields(iCols)) Then
resultArray(iRows, iCols) = CDate(CSV_Fields(iCols))
Else
resultArray(iRows, iCols) = CStr(CSV_Fields(iCols))
End If
Next
Next
Sheets(stockTicker).Range("A2").Resize(UBound(resultArray, 1) + 1, UBound(resultArray, 2) + 1).Value = resultArray
End Sub