Excel Dynamic Web query specific data from table and transpose the result using VBA code

Question

I am trying to write macro in excel to web query several sites to retrieve specific data from table. The web query is taking data in column A and displays results in Column C. The thing is that the table is being displayed in several rows and only two I need (date and price); rest to be deleted. The results should be transpose in columns B and C.(refresh every hour). How the query could take care to fetch the required data and also to run in loop for other rows in column A and displays in C and D. Help and support is appreciated since I am new to VBA

A     B      c        D
Site    Date/Time  Price
74156    xxx          yyy
85940
....
....

code is as follows

Sub test1()
Dim qt As QueryTable

Set qt = ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://www.petro-canada.ca/en/locations/4085.aspx?MODE=DTS&ID=" & Range("A2").Value, Destination:=Range("c2"))


With qt
    .Name = "Regular, Posted, Self serve"
    .WebSelectionType = xlSpecifiedTables
    .WebTables = "20"    ' Regular table
    .WebFormatting = xlWebFormattingNone
    .EnableRefresh = True
    .RefreshPeriod = 60   'Unit in minutes
    .Refresh     'Execute query
End With

End Sub

marc_s · Accepted Answer · 2016-02-12 19:03:45Z

2

Put your web query on a different page, then pull the data you need into your list on every refresh. Here's an example.

Sub GetPrices()

    Dim rCell As Range
    Dim lIDStart As Long
    Dim qt As QueryTable

    Const sIDTAG = "&ID="

    Application.EnableEvents = False

    Set qt = Sheet1.QueryTables(1)

    'loop through site IDs
    For Each rCell In Sheet2.Range("A2:A3").Cells
        'find the id parameter in the web query connection
        lIDStart = InStr(1, qt.Connection, sIDTAG)

        'if found, change the ID
        If lIDStart > 0 Then
            qt.Connection = Left$(qt.Connection, lIDStart - 1) & sIDTAG & rCell.Value
        Else 'if not found, add the id onto the end
            qt.Connection = qt.Connection & sIDTAG & rCell.Value
        End If

        'refresh the query table
        On Error Resume Next
            qt.Refresh False

            'if the web query worked
            If Err.Number = 0 Then
                'write the date
                rCell.Offset(0, 1).Value = Sheet1.Range("A2").Value
                'write the price
                rCell.Offset(0, 2).Value = Sheet1.Range("A4").Value
            Else 'if there was a problem with the query, write an error
                rCell.Offset(0, 1).Value = "Invalid Site"
                rCell.Offset(0, 2).Value = ""
            End If
        On Error GoTo 0
    Next rCell

    Application.EnableEvents = True

End Sub

An example can be found at http://www.dailydoseofexcel.com/excel/PetroWeb.xls

edited Feb 12, 2016 at 19:03

marc_s

760k186 gold badges1.4k silver badges1.5k bronze badges

answered May 26, 2011 at 15:00

Dick Kusleika

33.3k4 gold badges56 silver badges81 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

user770508 Over a year ago

Thanks for your prompt reply. Good idea of putting the query in other sheet. How about executing the queries for subsequent rows, do the previous query need to be deleted.I have tried your example but giving run time error 9. Where do I need to put the website url in the code. Again thanks for support

Dick Kusleika Over a year ago

You have only one query and you don't need to delete it. The code just changes that one query for each row. On which line do you get the error? My sheets had a CodeName of Sheet1 and Sheet2 so make sure yours match or you change the code. For the URL, create the query manually on the other sheet for the first Site - the URL will be stored in the query and you won't need it in the code.

user770508 Over a year ago

Hi Dick, have done as you mentionned, got error on second line. would you mind send me your excel sheet.Many thanks

user770508 Over a year ago

Thanks Dick. My problem is solved. I have reverse the sheet, that's why it was not working, now it is ok. You are great. Many thanks

Collectives™ on Stack Overflow

Excel Dynamic Web query specific data from table and transpose the result using VBA code

1 Answer 1

4 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

4 Comments

Your Answer

Sign up or log in

Post as a guest

Related