Doing all 47 pages at once may cause their site to block your IP.
Though usually only temporarily - a few minutes to a few days.
You could do it in sessions by changing "For i = 1 To 47" to the appropriate page numbers.
After each session be sure to rename the "Stats" sheet as the code starts by deleting and re-creating it.
After all sessions combine the various "Stat" sheets.
Doing all 47 at once will take a few minutes to complete and you won't see anything happening.
The cursor will only spin occasionally.
You wil get "Query complete" when it finishes.
Code:
Sub QueryWeb()
Dim i As Integer
Dim firstRow As Integer
Dim lastRow As Integer
Dim nextRow As Integer
Dim URLstart As String
Dim URLend As String
Dim shStats As Worksheet
Dim shQuery As Worksheet
Dim rgQuery As Range
Dim found As Range
Dim TimeOutWebQuery
Dim TimeOutTime
Dim objIE As Object
Application.ScreenUpdating = False
URLstart = "http://stats.espncricinfo.com/ci/engine/stats/index.html?class=2;filter=advanced;orderby=start;page="
URLend = ";size=200;spanmax1=12+Jul+2012;spanmin1=13+Jul+2009;spanval1=span;template=results;type=batting;view=innings;wrappertype=print"
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Stats").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Stats"
Set shStats = Sheets("Stats")
For i = 1 To 47
Sheets.Add after:=Sheets(Sheets.Count)
Set shQuery = ActiveSheet
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Visible = False
.Navigate CStr(URLstart & i & URLend)
End With
TimeOutWebQuery = 10
TimeOutTime = DateAdd("s", TimeOutWebQuery, Now)
Do Until objIE.ReadyState = 4
DoEvents
If Now > TimeOutTime Then
objIE.stop
GoTo ErrorTimeOut
End If
Loop
objIE.ExecWB 17, 2
objIE.ExecWB 12, 2
shQuery.Range("A1").Select
shQuery.PasteSpecial NoHTMLFormatting:=True
objIE.Quit
Set objIE = Nothing
Set found = shQuery.Columns(1).Find("Player", , , xlWhole)
If Not found Is Nothing Then
firstRow = found.Row
If i > 1 Then firstRow = firstRow + 1
Else
GoTo FormatError
End If
Set found = shQuery.Columns(1).Find("Page ", found, , xlPart)
If Not found Is Nothing Then
lastRow = found.Row - 1
Else
GoTo FormatError
End If
Set rgQuery = shQuery.Rows(firstRow & ":" & lastRow)
nextRow = shStats.Cells(Rows.Count, "A").End(xlUp).Row
If nextRow > 1 Then nextRow = nextRow + 1
rgQuery.Copy shStats.Cells(nextRow, 1)
Application.DisplayAlerts = False
shQuery.Delete
Application.DisplayAlerts = True
Next i
shStats.Columns.AutoFit
MsgBox "Query complete"
Exit Sub
FormatError:
MsgBox "Format Error"
Exit Sub
ErrorTimeOut:
objIE.Quit
Set objIE = Nothing
MsgBox "WebSite Error"
End Sub
