Originally Posted by
b_rad_1983
Rusty or not. Point us in the direction and we should be able to help out!
This is super ghetto but it gets the job done on my end...
Code:
Sub GetPitchingStats()
Dim startPitcher As Long
Dim lastPitcher As Long
Dim qualified As String
Dim lastRow As Long
startPitcher = 1
lastPitcher = 800
qualified = "false"
lastRow = 1
Application.ScreenUpdating = False
Do Until startPitcher > lastPitcher
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://espn.go.com/mlb/stats/pitching/_/count/" & startPitcher & "/qualified/" & qualified & "/order/false" _
, Destination:=Range("$A$" & lastRow))
.Name = "false"
.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 = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
'delete all blank cells in column R
Columns("R:R").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
'start back at cell B1
Range("B1").Select
'add one to the last row so it starts on a blank row next time
lastRow = Selection.End(xlDown).Row + 1
'increase the pitcher count by 40
startPitcher = startPitcher + 40
Loop
'a little cleanup
lastRow = Range("$B$5000").End(xlUp).Row
For i = 2 To lastRow
If Cells(i, 2) = "PLAYER" Then
Rows(i & ":" & i).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
End Sub