Consulting

Results 1 to 2 of 2

Thread: Asking about VBA in Excel

  1. #1

    Asking about VBA in Excel

    I have the code in VBA.xlsm (Macro1) to get data prices of the stock mmm with the URL in the code. This macro gets data into Cell A2 with code: Destination:=Cells(2, 1).
    I must do it, 496 times to get data prices for each stock :
    + With Cell A2, Data Prices for mmm.
    + With Cell H2, Data Prices for abt.
    + With Cell O2, Data prices for ....
    If I create 496 macros (or within 496 With ... End With Statements) like this, I will waste very much time. I want to do it with only 1 macro (or only 1 With ... End With Statement).
    Now, I can do as follows in VBA.xlsm (Macro2) to get data prices of the stock mmm into all Cells: A2, H2, O2 ... with Loops: For ... Next.
    If you understand my case, please help me.
    Attached Files Attached Files

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    Create two sheets in your workbook, StockCodes and Results.

    On StockCodes, list the stock in A1, A2, ...

    Then use this code (It will be slow)

    [VBA]Sub GetStockDetails()
    Const url As String = _
    "URL;http://finance.yahoo.com/q/hp?a=03&b=6&c=1983&d=01&e=9&f=2013&g=m&s=<ticker>&ql=1"
    Dim stock As Worksheet
    Dim results As Worksheet
    Dim qry As Object
    Dim col As Long

    Set stock = Worksheets("StockCodes")
    Set results = Worksheets("Results")
    For i = 1 To stock.Cells(stock.Rows.Count, "A").End(xlUp).Row

    col = (i - 1) * 7 + 1
    results.Cells(1, col).Value = stock.Cells(i, "A").Value

    Set qry = results.QueryTables.Add(Connection:=Replace(url, "<ticker>", stock.Cells(i, "A").Value), _
    Destination:=results.Cells(2, col))
    With qry

    .Name = "hp?a=03&b=6&c=1983&d=01&e=9&f=2013&g=m&s=" & stock.Cells(i, "A").Value & "&ql=1"
    .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 = "15"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
    End With

    qry.Delete
    Next i
    End Sub
    Sub Macro2()
    ' Macro2 Macro
    ' Keyboard Shortcut: Ctrl+Shift+H
    Dim i As Integer
    For i = 0 To 1
    With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://finance.yahoo.com/q/hp?a=03&b=6&c=1983&d=01&e=9&f=2013&g=m&s=mmm&ql=1", _
    Destination:=Cells(2, 1 + 7 * i))
    .Name = "hp?a=03&b=6&c=1983&d=01&e=9&f=2013&g=m&s=mmm&ql=1"
    .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 = "15"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
    End With
    Next i
    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

Posting Permissions

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