try this, heres the code i used...it's real basic, but it gets the job done...simple and quick...
open a new workbook, insert this code, and save the new book as an add in. if you dont know about add ins, let me know, its real simple.
let me know if you have problems.
ah
in module 1:
Sub Aut
pen()
MenuBars(xlWorksheet).Menus.Add _
Caption:="Stock_Info"
Set menuitemadded = MenuBars(xlWorksheet).Menus("Stock_Info").MenuItems _
.Add(Caption:="Template", _
OnAction:="add_sheets", _
before:=1)
Set menuitemadded = MenuBars(xlWorksheet).Menus("Stock_Info").MenuItems _
.Add(Caption:="Download", _
OnAction:="download", _
before:=2)
End Sub
Sub Auto_Close()
MenuBars(xlWorksheet).Menus("Stock_Info").Delete
End Sub
In module 2....
Sub add_sheets()
Application.ScreenUpdating = False
Workbooks.Add
Worksheets(1).Activate
Worksheets(1).Name = ("Template")
Application.DisplayAlerts = False
Worksheets(2).Delete
Worksheets(2).Delete
Range("A1").Select
ActiveCell.FormulaR1C1 = "Ticker"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Start Date"
Range("C1").Select
ActiveCell.FormulaR1C1 = "End Date"
Range("A1:C1").Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range("A1:C1").Select
Selection.Interior.ColorIndex = xlNone
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Columns("A:C").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Range("B2:C200").Select
Selection.NumberFormat = "m/d/yy"
Range("A1").Select
Cells.Select
Cells.EntireColumn.AutoFit
Range("A2").Select
End Sub
Sub Download()
Application.ScreenUpdating = False
Dim Sh As Worksheet
Dim Rng As Range
Dim Cell As Range
Dim Ticker As String
Dim StartDate As Date
Dim EndDate As Date
Dim a, b, c, d, e, f
Dim StrURL As String
Set Sh = Worksheets("Template")
Set Rng = Sh.Range("A2:A" & Sh.Range("A2").End(xlDown).Row)
For Each Cell In Rng
Ticker = Cell.Value
StartDate = Cell.Offset(0, 1).Value
EndDate = Cell.Offset(0, 2).Value
a = Format(Month(StartDate) - 1, "00") ' Month minus 1
b = Day(StartDate)
c = Year(StartDate)
d = Format(Month(EndDate) - 1, "00")
e = Day(EndDate)
f = Year(EndDate)
StrURL = "URL;http://table.finance.yahoo.com/table.csv?"
StrURL = StrURL & "s=" & Ticker & "&a=" & a & "&b=" & b
StrURL = StrURL & "&c=" & c & "&d=" & d & "&e=" & e
StrURL = StrURL & "&f=" & f & "&g=d&ignore=.csv"
ActiveWorkbook.Worksheets.Add.Name = Ticker
With ActiveSheet.QueryTables.Add(Connection:=StrURL, Destination:=Range("A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 4), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1))
Range("A2").Select
Range(Selection, Selection.End(xlDown)).NumberFormat = "d-mmm-yy"
Columns("A:F").EntireColumn.AutoFit
Next Cell
Sheets("Template").Select
End Sub