Error with macro trying to automate stock history download

[jpsmith1]

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

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

 

[Legacy 98055]

Did you see my reply to your other post? I can't help you without some more information...

 

[jpsmith1]

I saw that you said 'Tagging' so I was searching for topics on tagging. Obviously, I am a newbie with this stuff. Did you mean you wanted to see what I was working on? I did include a link to the actual file if that would make anything more clear. Thanks!

 

[Legacy 98055]

I missed the link in your orginal post. See it now.

 

[Legacy 98055]

edited

 

[jpsmith1]

Thank you! I will give it a shot tonight.