I am trying to write a macro that will automate the downloading of stock histories. I have a spreadsheet that you enter in the start and end date for the data and then uses the tickers in row 7 across the columns. I am just about there, but I get an error trying to paste the second ticker no matter if I start with column 2 or any other. Anyone know the root cause of this error?
Spreadsheet
Spreadsheet
Code:
Sub CollectData()
' This macro downloads stock data from Yahoo
Dim Page, Smonth, Sday, Syear, Fmonth, Fday, Fyear, Ticker As String
Dim finalrow, finalcolumn, c, finalrow2, r As Integer
Sheets("Data").Select
finalrow = Range("A65536").End(xlUp).Row
finalcolumn = Range("IV4").End(xlToLeft).Column
Smonth = Range("B4").Value - 1
Fmonth = Range("B5").Value - 1
Sday = Range("D4").Value
Fday = Range("D5").Value
Syear = Range("F4").Value
Fyear = Range("F5").Value
r = 7
For c = 3 To 4 ' change to finalcolumn when it works
Windows("Portfolio.xls").Activate
Sheets("Data").Select
Ticker = Cells(r, c).Value
On Error Resume Next
Program = "C:\Program Files\Internet Explorer\IEXPLORE.EXE"
TaskID = Shell(Program, 1)
If Err <> 0 Then
MsgBox "Cannot start " & Program, vbCritical, "Error"
End If
Application.Wait Now + TimeSerial(0, 0, 3)
SendKeys "%+FO"
SendKeys "http://ichart.finance.yahoo.com/table.csv?s=" & Ticker & "&a=" & Fmonth & "&b=" & Fday & "&c=" & Fyear & "&d=" & Smonth & "&e=" & Sday & "&f=" & Syear & "&g=w&ignore=.csv"
SendKeys "{enter}"
Application.Wait Now + TimeSerial(0, 0, 1)
SendKeys "S"
Application.Wait Now + TimeSerial(0, 0, 3)
SendKeys "c:\StockTable.csv{enter}"
Application.Wait Now + TimeSerial(0, 0, 3)
SendKeys "Y" 'to overwrite existing file
SendKeys "%+FC"
Application.Wait Now + TimeSerial(0, 0, 1)
Workbooks.Open Filename:="c:\StockTable.csv"
finalrow2 = Range("A65536").End(xlUp).Row
Range("G2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Portfolio.xls").Activate
Cells(8, c).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("StockTable.csv").Activate
If c = 2 Then
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Portfolio.xls").Activate
Range("A8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("StockTable.csv").Activate
End If
' Windows("StockTable.csv").Close False
SendKeys "%+FC"
SendKeys "N"
Application.Wait Now + TimeSerial(0, 0, 3)
Next c
End Sub