Thread: Web Query Loop help

Hello! I'm sure this has a simple solution, but I have a ways to go when it comes to VBA...

I am trying to pull information from multiple web pages for historical analysis. The fist site is http://www.swoopo.com/auction/100573.html each site is identical except for the number going up by one: 100573, 100574, ... will probably be pulling a thousand pages or so to begin with.

I'm looking for three pieces of information from the site: The product name, the final auction price, and the date/time the auction ended. The first product on A1:C1, second on A2:C2, and so on.

Excel does not recognize the final price as a table to import, so I may have to import it from the Bidding History table.

I have made the following macro for the first few sites as an example of what I am going for, however I haven't figured out how to loop it, and if an item had less than ten bids it would mess up all of the sites pulled afterward.

Any help would be TREMENDOUSLY appreciated!!

Code:

Sub Swoopo()

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.swoopo.com/auction/100573.html", Destination:=Range("$A$1"))
        .Name = "100573_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 = "7,12,14"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("A3").Select
    Selection.Cut
    Range("B1").Select
    ActiveSheet.Paste
    Range("A14").Select
    Selection.Cut
    Range("C1").Select
    ActiveSheet.Paste
    Rows("2:16").Select
    Selection.Delete Shift:=xlUp
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.swoopo.com/auction/100574.html", Destination:=Range("$A$2"))
        .Name = "100574_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 = "7,12,14"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("A4").Select
    Selection.Cut
    Range("B2").Select
    ActiveSheet.Paste
    Range("A15").Select
    Selection.Cut
    Range("C2").Select
    ActiveSheet.Paste
    Rows("3:17").Select
    Selection.Delete Shift:=xlUp
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.swoopo.com/auction/100575.html", Destination:=Range("$A$3"))
        .Name = "100575_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 = "7,12,14"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("A5").Select
    Selection.Cut
    Range("B3").Select
    ActiveSheet.Paste
    Range("A16").Select
    Selection.Cut
    Range("C3").Select
    ActiveSheet.Paste
    Rows("4:18").Select
    Selection.Delete Shift:=xlUp
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.swoopo.com/auction/100576.html", Destination:=Range("$A$4"))
        .Name = "100576"
        .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 = "7,12,14"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("A6").Select
    Selection.Cut
    Range("B4").Select
    ActiveSheet.Paste
    Range("A17").Select
    Selection.Cut
    Range("C4").Select
    ActiveSheet.Paste
    Rows("5:19").Select
    Selection.Delete Shift:=xlUp
End Sub