I've been trying to create a spreadsheet that can import historical data from a given start-date.... I have this code, but cannot get it to run for some reason....
Does anyone use something similar or know whats wrong with this code?
Sub Add_New(ByRef StockName)
Dim Stock As Integer, filelink As String, NewName As String
'Import Data
filelink = "http://ichart.yahoo.com/table.csv?s=" & StockName _
& "&a=04&b=16&c=1970&d=" & Month(Date) - 1 & "&e=" _
& Day(Date) & "&f=" & Year(Date) & "&g=d&ignore=.csv"
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Name = StockName
On Error GoTo Out
With Sheets(StockName).QueryTables.Add(Connection:="URL;" & filelink, Destination:=Sheets(StockName).Cells(1, 1))
.Name = "MS_Query"
.Refresh BackgroundQuery:=False
End With
On Error GoTo 0
'Parse Data
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), TrailingMinusNumbers:=True
Range("A:A").NumberFormat = "mm/dd/yyyy;@"
Columns.AutoFit
Sheets("Input").Select
Exit Sub
Out:
Application.DisplayAlerts = False
Worksheets(StockName).Delete
Application.DisplayAlerts = True
Sheets("Input").Select
NewName = UCase(InputBox("The ticker you entered is not valid on Yahoo Finance" & vbLf _
& "Enter a valid ticker", "Invalid Ticker", StockName))
Application.Goto Reference:="Symbols"
Application.EnableEvents = False
Selection.Replace What:=StockName, Replacement:=NewName
Application.EnableEvents = True
Add_New (NewName)
End Sub
Sub Add_New_Sheets()
Dim sh As Worksheet, flg As Integer, x As Object
For Each x In Range("Symbols")
If x = "" Then Exit For
flg = 0
For Each sh In Worksheets
If sh.Name = x Then flg = 1
Next sh
If flg = 0 Then
Add_New (x)
Else: End If
Next x
End Sub
Sub Sort_Tickers()
Application.EnableEvents = False
ActiveWorkbook.Worksheets("Input").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Input").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Input").Sort
.SetRange Range("Symbols")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.EnableEvents = True
End Sub
Sub Sort_Sheets()
Dim SheetCount As Integer, i As Integer, j As Integer
SheetCount = Worksheets.Count
If SheetCount = 1 Then Exit Sub
For i = 1 To SheetCount - 1
For j = i + 1 To SheetCount
If Worksheets(j).Name < Worksheets(i).Name Then Worksheets(j).Move Before:=Worksheets(i)
Next j
Next i
Sheets("Input").Move Before:=Sheets(1)
End Sub
Sub Delete_Old_Sheets()
Dim sh As Worksheet, flg As Integer, x As Object
For Each sh In Worksheets
flg = 0
For Each x In Range("Symbols")
If x = "" Then Exit For
If sh.Name = x Then flg = 1
Next x
Application.DisplayAlerts = False
If flg = 0 And sh.Name <> "Input" Then sh.Delete
Application.DisplayAlerts = True
Next sh
End Sub
Sub Refresh_All()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In Worksheets
If sh.Name <> "Input" And Range(sh.Name & "!A2").Value <> Date - 1 Then sh.Delete
Next sh
Application.DisplayAlerts = True
Add_New_Sheets
End Sub
Sub Chart()
Dim myChtObj As Object, sh As Worksheet, x As Integer
ActiveSheet.ChartObjects("Closing_Chart").Delete
Set myChtObj = ActiveSheet.ChartObjects.Add _
(Left:=275, Width:=600, Top:=0, Height:=300)
'myChtObj.Chart.ChartType = xlXYScatterLines
ActiveSheet.ChartObjects(myChtObj.Name).Name = "Closing_Chart"
For Each sh In Worksheets
If sh.Index <> 1 Then
With myChtObj.Chart.SeriesCollection.NewSeries
.Name = sh.Name
.Values = "'" & sh.Name & "'!$G$2:$G$1000"
.XValues = "'" & sh.Name & "'!$A$2:$A$1000"
End With
Else: End If
Next
ActiveSheet.ChartObjects("Closing_Chart").Activate
ActiveChart.ChartType = xlLine
ActiveChart.Axes(xlCategory).Select
End Sub
Does anyone use something similar or know whats wrong with this code?
Sub Add_New(ByRef StockName)
Dim Stock As Integer, filelink As String, NewName As String
'Import Data
filelink = "http://ichart.yahoo.com/table.csv?s=" & StockName _
& "&a=04&b=16&c=1970&d=" & Month(Date) - 1 & "&e=" _
& Day(Date) & "&f=" & Year(Date) & "&g=d&ignore=.csv"
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Name = StockName
On Error GoTo Out
With Sheets(StockName).QueryTables.Add(Connection:="URL;" & filelink, Destination:=Sheets(StockName).Cells(1, 1))
.Name = "MS_Query"
.Refresh BackgroundQuery:=False
End With
On Error GoTo 0
'Parse Data
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), TrailingMinusNumbers:=True
Range("A:A").NumberFormat = "mm/dd/yyyy;@"
Columns.AutoFit
Sheets("Input").Select
Exit Sub
Out:
Application.DisplayAlerts = False
Worksheets(StockName).Delete
Application.DisplayAlerts = True
Sheets("Input").Select
NewName = UCase(InputBox("The ticker you entered is not valid on Yahoo Finance" & vbLf _
& "Enter a valid ticker", "Invalid Ticker", StockName))
Application.Goto Reference:="Symbols"
Application.EnableEvents = False
Selection.Replace What:=StockName, Replacement:=NewName
Application.EnableEvents = True
Add_New (NewName)
End Sub
Sub Add_New_Sheets()
Dim sh As Worksheet, flg As Integer, x As Object
For Each x In Range("Symbols")
If x = "" Then Exit For
flg = 0
For Each sh In Worksheets
If sh.Name = x Then flg = 1
Next sh
If flg = 0 Then
Add_New (x)
Else: End If
Next x
End Sub
Sub Sort_Tickers()
Application.EnableEvents = False
ActiveWorkbook.Worksheets("Input").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Input").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Input").Sort
.SetRange Range("Symbols")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.EnableEvents = True
End Sub
Sub Sort_Sheets()
Dim SheetCount As Integer, i As Integer, j As Integer
SheetCount = Worksheets.Count
If SheetCount = 1 Then Exit Sub
For i = 1 To SheetCount - 1
For j = i + 1 To SheetCount
If Worksheets(j).Name < Worksheets(i).Name Then Worksheets(j).Move Before:=Worksheets(i)
Next j
Next i
Sheets("Input").Move Before:=Sheets(1)
End Sub
Sub Delete_Old_Sheets()
Dim sh As Worksheet, flg As Integer, x As Object
For Each sh In Worksheets
flg = 0
For Each x In Range("Symbols")
If x = "" Then Exit For
If sh.Name = x Then flg = 1
Next x
Application.DisplayAlerts = False
If flg = 0 And sh.Name <> "Input" Then sh.Delete
Application.DisplayAlerts = True
Next sh
End Sub
Sub Refresh_All()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In Worksheets
If sh.Name <> "Input" And Range(sh.Name & "!A2").Value <> Date - 1 Then sh.Delete
Next sh
Application.DisplayAlerts = True
Add_New_Sheets
End Sub
Sub Chart()
Dim myChtObj As Object, sh As Worksheet, x As Integer
ActiveSheet.ChartObjects("Closing_Chart").Delete
Set myChtObj = ActiveSheet.ChartObjects.Add _
(Left:=275, Width:=600, Top:=0, Height:=300)
'myChtObj.Chart.ChartType = xlXYScatterLines
ActiveSheet.ChartObjects(myChtObj.Name).Name = "Closing_Chart"
For Each sh In Worksheets
If sh.Index <> 1 Then
With myChtObj.Chart.SeriesCollection.NewSeries
.Name = sh.Name
.Values = "'" & sh.Name & "'!$G$2:$G$1000"
.XValues = "'" & sh.Name & "'!$A$2:$A$1000"
End With
Else: End If
Next
ActiveSheet.ChartObjects("Closing_Chart").Activate
ActiveChart.ChartType = xlLine
ActiveChart.Axes(xlCategory).Select
End Sub
