Web Query - Use cell reference in web address

[leeksleeks]

Hi,

I was wondering if anyone could help with this query. I have a worksheet that imports data from a website using a simple web query import. The thing is there are 3 different sections of the web address that I would like vba to replace each time based on text that is in Cells A2, B2 and D2.

For example:[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"]A2[/TD]
[TD="align: center"]B2[/TD]
[TD="align: center"]C2[/TD]
[TD="align: center"]D2[/TD]
[/TR]
</tbody>[/TABLE]

​

[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"]Apples[/TD]
[TD="align: center"]Bananas[/TD]
[TD="align: center"]Blank[/TD]
[TD="align: center"]Plums[/TD]
[/TR]
[TR]
[TD="align: center"]Grapes[/TD]
[TD="align: center"]Lemons[/TD]
[TD="align: center"]Blank[/TD]
[TD="align: center"]Oranges[/TD]
[/TR]
</tbody>[/TABLE]

The web query that it imports the data from is like the address below:

www.fruit.com/apples/bananas/plums

So what I would like the code to do is that once it has finished importing the data from the above web address, I would then like it to move onto the next query using Grapes/Lemons/Oranges which are in cells B2,C2,D2 and so on and so on.

I would like this to continue to loop through a worksheet called "Data" until there is no fruit left.

Is this possible? I thank you in advance. I dont have a fruit addiction fyi.......

Cheers!

 

[Andrew Poulsom]

Do you already have a macro that creates the web query? If so please post it.

 

[leeksleeks]

Hi Andrew,

I don't have a macro to create the web query yet. It's only in its infancy but basically I want each webquery to be displayed on a new worksheet. There will be one worksheet that has a list of sporting fixtures on it. On worksheet "Data" in Cell A2 is the competition. In Cell B2 is Team A and in Cell D2 is Team B. The way the web address appears is www . rugbydata . com /(Competition)/(Team A)/(Team B). The web import of one of these pages is as below:

 With ActiveSheet.QueryTables.Add(Connection:= _        "URL;http://www.rugbydata.com/guinness/gloucester/harlequins", Destination:= _
        Range("$A$1"))
        .Name = "harlequins"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = True
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

Does this make more sense?

Cheers

 

[Andrew Poulsom]

Try:

Sub Test()
    Dim ShNew As Worksheet
    Dim c As Long
    Dim r As Long
    Dim QT As QueryTable
    Dim URL As String
    Dim Team As String
    Set ShNew = Worksheets.Add
    c = 1
    With Worksheets("Data")
        For r = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
            URL = "Rugbydata - Rugby stats for rugby union matches" & .Range("A" & r).Value & "/" & .Range("B" & r).Value & "/" & .Range("D" & r).Value
            Team = .Range("D" & r).Value
            With ShNew.QueryTables.Add(Connection:="URL;" & URL, Destination:=ShNew.Cells(1, c))
                .Name = Team
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlEntirePage
                .WebFormatting = xlWebFormattingNone
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = True
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            c = c + 1
        Next r
    End With
End Sub

 

[leeksleeks]

It is coming back with an error "'Run-time error 1004'. Unable to open Rugbydata - Rugby stats for the rugby union matches etc". Is that because the code has the URL as

[COLOR=#333333]URL = "[/COLOR][URL="http://www.rugbydata.com/"]Rugbydata - Rugby stats for rugby union matches[/URL][COLOR=#333333]" & .Range("A" & r).Value & "/" & .Range("B" & r).Value & "/" & .Range("D" & r).Value[/COLOR]

When i debug it it comes up as .Refresh BackgroundQuery:=False

Cheers

 

[Andrew Poulsom]

The Board has parsed the URL which I didn't notice, sorry. The line of code should be:

URL = "http://www.rugbydata.com/" & .Range("A" & r).Value & "/" & .Range("B" & r).Value & "/" & .Range("D" & r).Value

 

[leeksleeks]

That's done the trick! The only thing is that it is collating all the data on one worksheet instead of a new worksheet each time. Once it has run the web query for each fixtures, could the next webpage then be imported to a new worksheet? This is just tidying it up but as always Andrew you have been awesome!

 

[Andrew Poulsom]

That would require some minor changes to the VBA code:

Sub Test()
    Dim ShNew As Worksheet
    Dim r As Long
    Dim URL As String
    Dim Team As String
    With Worksheets("Data")
        For r = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
            URL = "http://www.rugbydata.com/" & .Range("A" & r).Value & "/" & .Range("B" & r).Value & "/" & .Range("D" & r).Value
            Team = .Range("D" & r).Value
            Set ShNew = Worksheets.Add
            With ShNew.QueryTables.Add(Connection:="URL;" & URL, Destination:=ShNew.Range("A1"))
                .Name = Team
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlEntirePage
                .WebFormatting = xlWebFormattingNone
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = True
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
        Next r
    End With
End Sub

 

[leeksleeks]

Perfect. Thanks again!!!

 

[leeksleeks]

One final question. If the webquery returns a runtime error 1004 when the page it is looking for doesnt exist, how do you get the macro to ignore that webpage and move onto the next one? I have tried on error resume next and that continues running the macro and throws the whole thing off course.

Cheers