Help with web query VBA

[largeselection]

I have a simple spreadsheet and I want it to create a web query based on a list of URLs I list.

In my sheet I list the URLs one every 3 rows (because the web query table it pulls back is 3 rows). So currently the loop is working, but it's pulling the same URL back rather than changing so something funky is in my code and I don't see it.

Sub CreateContents()
Dim ID As String

ID = Selection.Value
Range("A3").Select
Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0)) And IsEmpty(ActiveCell.Offset(2, 0))

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & ID & "", Destination:=Selection.Offset(0, 1))
        .Name = ID
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingAll
        .WebTables = "4"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
ActiveCell.Offset(3, 0).Select
Loop
End Sub

So I have 3 different URLs listed and it loops through and adds the web query part for just the first URL next to all 3.

 

[Ruddles]

You're only setting the value of ID once at the top of the routine: you should be setting it inside the DO..UNTIL loop, before the With ActiveSheet.QueryTables.Add, so it changes as you move down the sheet.

 

[largeselection]

Ah brilliant. Right you are.

Thanks for the assist.

 

[largeselection]

New issue- So I don't want it to keep refreshing/recreating the web queries for URLs it has already completed. I only want it to do this for any new URLs that are added to the list. So I thought changing the Do statement to achieve this

Do While IsEmpty(activecell.offset(0,1)) AND NOT IsEmpty(activecell))

But this does not work. It does not loop because the first URL has already pulled the query so the cell in the next column is not empty.

I basically want to do something like Do until activecell is empty, but only if the cell next to the activecell is empty. That way it will skip through the URLs that have already created the webqueries and just add webqueries to the new URLs.

 

[Ruddles]

That extra condition shouldn't control the loop, it should only decide whether or not you want to execute the query. Try this:-

[FONT=Courier New][SIZE=1]Sub CreateContents()[/SIZE][/FONT]
[FONT=Courier New][SIZE=1]    Dim ID As String
    
    Range("A3").Select
    Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0)) And IsEmpty(ActiveCell.Offset(2, 0))
      [/SIZE][/FONT][SIZE=1][FONT=Courier New][COLOR=red][B]  If IsEmpty(ActiveCell.Offset(0, 1)) Then
[/B][/COLOR]            ID = Selection.Value
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;" & ID & "", Destination:=Selection.Offset(0, 1))
                .Name = ID
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = False
                .RefreshPeriod = 0
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingAll
                .WebTables = "4"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
        [/FONT][/SIZE][SIZE=1][FONT=Courier New][COLOR=red][B]End If
[/B][/COLOR]        ActiveCell.Offset(3, 0).Select
    Loop
    
End Sub[/FONT][/SIZE]

 

[largeselection]

ah Fabulous. Thank you again.