Consulting

Results 1 to 4 of 4

Thread: Asking about Using VBA in Excel for Download Financial Data

  1. #1

    Asking about Using VBA in Excel for Download Financial Data

    In my attached excel file that I get from the website of investexcel and it can do: Download all financial data with symbols from Cells A11 (Worksheet: Parameters) to last row of column A. The results that each symbol data is copied to new sheet with sheet name is the symbol name. With n symbols, we have n new sheets.
    I have a situation. I want to download n symbol data to only one new sheet. The 1st symbol data is in Cell A1, Sheet DATA. The 2nd symbol data is in Cell H1, Sheet DATA ....
    If you know to modify this code. Please, help me as soon as possible.
    Thank you.
    Attached Files Attached Files

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [VBA]'http://investexcel.net

    Sub DownloadData()
    Dim ws As Worksheet
    Dim StockTicker As String
    Dim frequency As String
    Dim numRows As Long
    Dim lastrow As Long
    Dim datacol As Long

    Application.ScreenUpdating = False

    lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    frequency = Worksheets("Parameters").Range("B7")

    'Delete all sheets apart from Parameters sheet
    Application.DisplayAlerts = False
    For Each ws In Worksheets

    If ws.Name <> "Parameters" Then ws.Delete
    Next
    Application.DisplayAlerts = True

    'Add DATA worksheet
    Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    ws.Name = "DATA"

    'Loop through all tickers
    With Worksheets("Parameters")

    datacol = 1

    For ticker = 11 To lastrow

    StockTicker = .Range("$A$" & ticker)

    If StockTicker <> "" Then

    Cells(1, datacol) = "Stock Quotes for " & StockTicker
    Call DownloadStockQuotes(StockTicker:=StockTicker, _
    StartDate:=.Range("$B$5"), _
    EndDate:=.Range("$B$6"), _
    DestinationCell:=ws.Cells(2, datacol), _
    freq:=frequency)
    ws.Columns(datacol).TextToColumns Destination:=ws.Cells(1, datacol), _
    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))
    ws.Cells(2, datacol).Resize(lastrow, 7).Sort Key1:=ws.Cells(2, datacol), _
    Order1:=xlDescending, _
    Header:=xlYes
    ws.Columns(datacol).Resize(, 7).ColumnWidth = 10
    End If

    datacol = datacol + 7
    Next ticker
    End With

    If Sheets("Parameters").Range("exportToCSV") Then
    On Error GoTo ErrorHandler:
    Call CopyToCSV
    End If

    ErrorHandler:
    Worksheets("Parameters").Select
    Application.ScreenUpdating = True
    End Sub

    Sub DownloadStockQuotes( _
    ByVal StockTicker As String, _
    ByVal StartDate As Date, _
    ByVal EndDate As Date, _
    ByVal DestinationCell As Range, _
    ByVal freq As String)

    Dim qurl As String
    Dim StartMonth, StartDay, StartYear, EndMonth, EndDay, EndYear As String
    StartMonth = Format(Month(StartDate) - 1, "00")
    StartDay = Format(Day(StartDate), "00")
    StartYear = Format(Year(StartDate), "00")

    EndMonth = Format(Month(EndDate) - 1, "00")
    EndDay = Format(Day(EndDate), "00")
    EndYear = Format(Year(EndDate), "00")
    qurl = "URL;http://table.finance.yahoo.com/table.csv?s=" + StockTicker + "&a=" + StartMonth + "&b=" + StartDay + "&c=" + StartYear + "&d=" + EndMonth + "&e=" + EndDay + "&f=" + EndYear + "&g=" + freq + "&ignore=.csv"

    On Error GoTo ErrorHandler:
    With ActiveSheet.QueryTables.Add(Connection:=qurl, Destination:=DestinationCell)
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "20"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
    End With
    ErrorHandler:
    End Sub

    Sub CopyToCSV()
    Dim ws As Worksheet
    Dim myPath As String
    Dim myFileName As String
    Dim frequency As String
    Dim dateFrom As Date
    Dim dateTo As Date
    Dim lastrow As Long
    Dim lastcol As Long
    Dim i As Long

    Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))

    With Worksheets("Parameters")

    dateFrom = .Range("$B$5")
    dateTo = .Range("$B$6")
    frequency = .Range("$B$7")
    End With

    myPath = "c:\temp\"
    If Not Right(myPath, 1) = "\" Then myPath = myPath & "\"

    With Worksheets("DATA")

    lastcol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    For i = 1 To lastcol Step 7

    lastrow = .Cells(.Rows.Count, i).End(xlUp).Row
    ticker = Replace(.Cells(1, i).Value, "Stock Quotes for ", "")
    myFileName = ticker & " " & Format(dateFrom, "dd-mm-yyyy") & " - " & Format(dateTo, "dd-mm-yyyy") & " " & frequency
    If Not Right(myFileName, 4) = ".csv" Then myFileName = myFileName & ".csv"

    .Cells(1, i).Resize(lastrow, 7).Copy ws.Range("A1")
    ws.Copy
    With ActiveWorkbook

    .SaveAs Filename:=myPath & myFileName, _
    FileFormat:=xlCSV, _
    CreateBackup:=False
    .Close False
    End With
    ws.UsedRange.ClearContents
    End If

    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True
    Next
    End Sub[/VBA]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3

    VBA

    Thank you very much.

  4. #4

    VBA

    I want to modify the VBA code as follows:
    Don't create new DATA sheet, and delete all sheets without "Parameters" Sheet. It can download data into DATA sheet that created before. Data downloaded into DATA with format as follows: Stock Data is in 3rd row of the DATA sheet.
    Please once time, help me.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •