Web Query Loop help

[brandon_scott]

Hello! I'm sure this has a simple solution, but I have a ways to go when it comes to VBA...
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
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.
<o> </o>
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.
<o> </o>
Excel does not recognize the final price as a table to import, so I may have to import it from the Bidding History table.
<o> </o>
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.
<o> </o>
Any help would be TREMENDOUSLY appreciated!!
<o> </o>

Sub Swoopo()
<o:p> </o:p>
    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

 

[wigi]

Hi

This is better code to do it:

Sub Swoopo()

    Const sOutputSheet = "Sheet3"
    
    Application.ScreenUpdating = False
    
    With Sheets(sOutputSheet)
        .Cells.ClearContents
        .Range("A1:C1").Value = Array("name", "price", "end")
    End With

    For l = 100573 To 100576
 
        With ActiveSheet.QueryTables.Add("URL;http://www.swoopo.com/auction/" & l & ".html", Range("A1"))
            .WebTables = "7,12,14"
            .Refresh False
        End With
        
        With Sheets(sOutputSheet)
        
            .Range("A" & Rows.Count).End(xlUp).Offset(1).Value = [A1]
            .Range("B" & Rows.Count).End(xlUp).Offset(1).Value = [A3]
            .Range("C" & Rows.Count).End(xlUp).Offset(1).Value = _
                Cells.Find(what:="auction ended", lookat:=xlPart, LookIn:=xlValues).Value
        End With
        
        Cells.ClearContents
        
    Next
    
    Application.ScreenUpdating = True
        
End Sub

Change the name of the output sheet at the top if needed.

Wigi

 

[brandon_scott]

Thank you wigi! Works great!

 

[wigi]

Thank you wigi! Works great!

You're welcome

 

[brandon_scott]

Wigi, turns out going up in sequential order some of the sites don't have auction data (for example http://www.swoopo.com/auction/100587.html). Is there a way to skip a site if it doesn't have auction data? Currently it asks to Debug and highlights this section of code:

.Range("C" & Rows.Count).End(xlUp).Offset(1).Value = _
                Cells.Find(what:="auction ended", lookat:=xlPart, LookIn:=xlValues).Value

 

[wigi]

Hello

Try the adjusted code:

Sub Swoopo()

    Const sOutputSheet = "Sheet3"
    
    Application.ScreenUpdating = False
    
    With Sheets(sOutputSheet)
        .Cells.ClearContents
        .Range("A1:C1").Value = Array("name", "price", "end")
    End With

    For l = 100573 To 100576
 
        With ActiveSheet.QueryTables.Add("URL;http://www.swoopo.com/auction/" & l & ".html", Range("A1"))
            .WebTables = "7,12,14"
            .Refresh False
        End With
        
        With Sheets(sOutputSheet)
        
            On Error Resume Next
            .Range("C" & Rows.Count).End(xlUp).Offset(1).Value = _
                Cells.Find(what:="auction ended", lookat:=xlPart, LookIn:=xlValues).Value
            If Err.Number <> 0 Then
                Err.Clear
            Else
                .Range("A" & Rows.Count).End(xlUp).Offset(1).Value = [A1]
                .Range("B" & Rows.Count).End(xlUp).Offset(1).Value = [A3]
            End If
            
        End With
        
        Cells.ClearContents
        
    Next
    
    Application.ScreenUpdating = True
        
End Sub

 

[brandon_scott]

Thank you sir, you are a scholar and a gentleman.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

 

[Jaredhott]

Hey Wigi

I was wondering if you could help me on what looks to be a similar web query problem. Here is my code so far:

WEB
1
Player Index | College Football at Sports-Reference.com["name","EnterName"].html


Selection=passing
Formatting=None
PreFormattedTextToColumns=True
ConsecutiveDelimitersAsOne=True
SingleBlockTextImport=False
DisableDateRecognition=False
DisableRedirections=False


I want to gather college data from over 300 quarterbacks. With the code above I can enter a name of the quarterback I want and it pulls the data for him individually however I do not want to have to do that one by one for over 300 quarterbacks. I have a list compiled of the quarterbacks I want data for and was wondering how to make code to select each quarterback from the list one by one and compile the data into a table.

Thanks, I would be greatful for any assistance.