I need to add a new MACRO or enhance my existing download(WORKING) MACRO to do a few things more.Currentlyit downloads my stock history data (5 years + YTD) into the BackTest columns A:G for a singleStock Symbol that is entered in the Setup worksheet along with a StartDate and EndDatefor the data. It is activated by a BUTTON [Get Yahoo Data] from the"Setup" worksheet.
My thoughts are that making a copy of the existing MACRO (DataDownload) and enhancing it to add the following features is the wayto go.
It needs to:
- Select a BUTTON "Multiple Stock Quotes" to activate the new MACRO (MultipleStockQuotes)
- The existing StartDate and EndDate will be used. (Enteredon the Setup worksheet)
- Extracting multiple Stock Symbols from column"A" (one at a time) of the (ActiveStockSymbols) worksheet. Therecould be 10 to 2500+ Stock Symbols in column "A".
- MACRO selects the first Symbol, downloads the data (sameexisting StartDate, EndDate), enters it in "BackTest" col A:G,recalculate BackTest worksheet, copy data from BackTest AJ2 through AS2inclusive into the next empty row in SummaryReport (first row to use is) A2through J2,
- Select next Stock Symbol and loop until last Symbol incolumn "A" is used.
- End program
I have tried a bunch of loops, but was unable to get anywherewith them. I need to take a break from the LOOP and work on the copy portion of the macro.
Don
-------------------------------------------------------------------------------------
Single Stock Quote Macro
-------------------------------------------------------------------------------------
<strike></strike>
My thoughts are that making a copy of the existing MACRO (DataDownload) and enhancing it to add the following features is the wayto go.
It needs to:
- Select a BUTTON "Multiple Stock Quotes" to activate the new MACRO (MultipleStockQuotes)
- The existing StartDate and EndDate will be used. (Enteredon the Setup worksheet)
- Extracting multiple Stock Symbols from column"A" (one at a time) of the (ActiveStockSymbols) worksheet. Therecould be 10 to 2500+ Stock Symbols in column "A".
- MACRO selects the first Symbol, downloads the data (sameexisting StartDate, EndDate), enters it in "BackTest" col A:G,recalculate BackTest worksheet, copy data from BackTest AJ2 through AS2inclusive into the next empty row in SummaryReport (first row to use is) A2through J2,
- Select next Stock Symbol and loop until last Symbol incolumn "A" is used.
- End program
I have tried a bunch of loops, but was unable to get anywherewith them. I need to take a break from the LOOP and work on the copy portion of the macro.
Don
-------------------------------------------------------------------------------------
Single Stock Quote Macro
-------------------------------------------------------------------------------------
Code:
Sub DataDownload()
'From workbook = stockbacktest (1).xls
Dim xConect As Object
Dim QuerySheet As Worksheet
Dim SettingsSheet As Worksheet
Dim EndDate As Date
Dim StartDate As Date
Dim SYMBOL As String
Dim qurl As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks("BackTest From Scratch - 3.xlsm").Worksheets("BackTest").Range("a:g").ClearContents
Set SettingsSheet = Workbooks("BackTest From Scratch - 3.xlsm").Worksheets("Setup")
SYMBOL = SettingsSheet.Range("D5")
StartDate = SettingsSheet.Range("D6").Value
EndDate = SettingsSheet.Range("D7").Value
qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & SYMBOL
qurl = qurl & "&a=" & Month(StartDate) + 10 & "&b=" & Day(StartDate) & _
"&c=" & Year(StartDate) - 1 & "&d=" & Month(EndDate) - 1 & "&e=" & _
Day(EndDate) & "&f=" & Year(EndDate) & "&g=d&q=q&y=0&z=" & _
SYMBOL & "&x=.csv"
QueryQuote:
Set QuerySheet = Workbooks("BackTest From Scratch - 3.xlsm").Worksheets("BackTest")
With QuerySheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=QuerySheet.Range("a1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
On Error Resume Next
.Refresh BackgroundQuery:=False
.SaveData = True
Sheets("BackTest").Range("a1").CurrentRegion.TextToColumns Destination:=Sheets("BackTest").Range("a1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False
Sheets("BackTest").Columns("A:G").AutoFit
LastRow = Sheets("BackTest").UsedRange.Row - 2 + Sheets("BackTest").UsedRange.Rows.Count
Sheets("BackTest").Columns("A:G").ColumnWidth = 12
Sheets("BackTest").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheets("BackTest").Sort
.SetRange Range("A1:G" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
.SortFields.Clear
End With
Application.CalculateFullRebuild
Do Until Application.CalculationState = xlDone
DoEvents
Loop
End With
End Sub
Last edited: