Results 1 to 4 of 4

Thread: [RESOLVED] Multiple URL's but I don't know how to create a loop

  1. #1

    Thread Starter
    New Member
    Join Date
    Jul 2012
    Posts
    2

    Resolved [RESOLVED] Multiple URL's but I don't know how to create a loop

    This I'm sure is going to be simply to most but I'm just learning VB. I have 'sheet1' that has hundreds of URL's all in column A. What I want to do is to paste the historical prices from the URL's into 'sheet2'. I have the first 4 URL's in a macro but I'd like for it to loop and keep pulling the data from each subsequent URL and pasting it 30 rows below the last one. I hope someone can help, I've worked on this for a long time and I just can't figure it out on my own.

    Code:
    Sub Import_Historical_Prices()
    '
    ' Import_Historical_Prices Macro
    '
    
    '
        Sheets("Sheet1").Select
        Range("A1").Select
        ActiveCell.FormulaR1C1 = _
            "http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAA"
        Range("A2").Select
        Sheets("Sheet2").Select
        ActiveSheet.Paste
        Range("A2").Select
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAA" _
            , Destination:=Range("$A$2"))
            .Name = "historicdata.aspx?symbol=AAA_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 = """tblHistoryTable"""
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
        Range("A31").Select
        Sheets("Sheet1").Select
        ActiveCell.FormulaR1C1 = _
            "http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAB"
        Range("A3").Select
        Sheets("Sheet2").Select
        ActiveSheet.Paste
        Range("A32").Select
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAB" _
            , Destination:=Range("$A$32"))
            .Name = "historicdata.aspx?symbol=AAB_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 = """tblHistoryTable"""
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
        Range("A61").Select
        Sheets("Sheet1").Select
        ActiveCell.FormulaR1C1 = _
            "http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAH"
        Range("A4").Select
        Sheets("Sheet2").Select
        ActiveSheet.Paste
        Range("A62").Select
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAH" _
            , Destination:=Range("$A$62"))
            .Name = "historicdata.aspx?symbol=AAH"
            .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 = """tblHistoryTable"""
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
        Range("A91").Select
        Sheets("Sheet1").Select
        ActiveCell.FormulaR1C1 = _
            "http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAV"
        Range("A5").Select
        Sheets("Sheet2").Select
        ActiveSheet.Paste
        Range("A92").Select
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://ca.moneycentral.msn.com/investor/charts/historicdata.aspx?symbol=AAV" _
            , Destination:=Range("$A$92"))
            .Name = "historicdata.aspx?symbol=AAV"
            .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 = """tblHistoryTable"""
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    End Sub

  2. #2
    Discovering Life Siddharth Rout's Avatar
    Join Date
    Feb 2005
    Location
    Mumbai, India
    Posts
    12,001

    Re: Multiple URL's but I don't know how to create a loop

    Thread Moved to Office Development.
    A good exercise for the Heart is to bend down and help another up...
    Please Mark your Thread "Resolved", if the query is solved


    MyGear:
    ★ CPU ★ Ryzen 5 5800X
    ★ GPU ★ NVIDIA GeForce RTX 3080 TI Founder Edition
    ★ RAM ★ G. Skill Trident Z RGB 32GB 3600MHz
    ★ MB ★ ASUS TUF GAMING X570 (WI-FI) ATX Gaming
    ★ Storage ★ SSD SB-ROCKET-1TB + SEAGATE 2TB Barracuda IHD
    ★ Cooling ★ NOCTUA NH-D15 CHROMAX BLACK 140mm + 10 of Noctua NF-F12 PWM
    ★ PSU ★ ANTEC HCG-1000-EXTREME 1000 Watt 80 Plus Gold Fully Modular PSU
    ★ Case ★ LIAN LI PC-O11 DYNAMIC XL ROG (BLACK) (G99.O11DXL-X)
    ★ Monitor ★ LG Ultragear 27" 240Hz Gaming Monitor
    ★ Keyboard ★ TVS Electronics Gold Keyboard
    ★ Mouse ★ Logitech G502 Hero

  3. #3
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Multiple URL's but I don't know how to create a loop

    try like

    vb Code:
    1. set sht1 = sheets("sheet1")
    2. set sht2 = sheets("sheet2")
    3. lastrow = sht1.cells(sht1.rows.count, 1).end(xlup).row
    4. for rw = 2 to lastrow
    5.       With sht2.QueryTables.Add(Connection:= _
    6.         "URL;" & sht1.cells(rw, 1).value _
    7.         , Destination:=sht2.cells((rw-2) * 30 + 2, 1))
    8.         .Name = "historicdata.aspx?symbol=" & right(sht1.cells(rw, 1),3) & "_1"
    9.         .FieldNames = True
    10.         .RowNumbers = False
    11.         .FillAdjacentFormulas = False
    12.         .PreserveFormatting = True
    13.         .RefreshOnFileOpen = False
    14.         .BackgroundQuery = True
    15.         .RefreshStyle = xlInsertDeleteCells
    16.         .SavePassword = False
    17.         .SaveData = True
    18.         .AdjustColumnWidth = True
    19.         .RefreshPeriod = 0
    20.         .WebSelectionType = xlSpecifiedTables
    21.         .WebFormatting = xlWebFormattingNone
    22.         .WebTables = """tblHistoryTable"""
    23.         .WebPreFormattedTextToColumns = True
    24.         .WebConsecutiveDelimitersAsOne = True
    25.         .WebSingleBlockTextImport = False
    26.         .WebDisableDateRecognition = False
    27.         .WebDisableRedirections = False
    28.         .Refresh BackgroundQuery:=False
    29.     End With
    30. next
    i have not tested this at all, you may need to change the calculation for the destination row, if it is not quite as i envision it
    i have not made any provision to test if the next querytable will fit on the sheet, as i assume it could outgrow the number of rows in a sheet
    Last edited by westconn1; Jul 24th, 2012 at 04:23 PM.
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  4. #4

    Thread Starter
    New Member
    Join Date
    Jul 2012
    Posts
    2

    Re: [RESOLVED] Multiple URL's but I don't know how to create a loop

    Thanks Westconn1,

    It looks like it works.

    Thanks, I had been working on this way too long.

    Q

Posting Permissions

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



Click Here to Expand Forum to Full Width