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
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