VBA historical data help

Discussion in 'Data Sets and Feeds' started by Im Bullish, Jul 7, 2009.

  1. Im Bullish

    Im Bullish

    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
     
    #1     Jul 7, 2009
    Share
  2. nitro

    nitro

    #2     Jul 7, 2009
    Share