Web Connection for Sports standings

The following VBA code will retrieve data from a web query of sports.yahoo and create a spreadsheet with the standings of a specified sport. The two parameters of the URL statement is the sport name and the year. Just change the parameters of the URL statement to copy the selected web site.

This new spreadsheets will requires deleting a few lines and a few columns.

When copying in Excel hyphens separating numbers are used to designate a date field. The QueryTables opiton ".WebDisableDateRecognition = True" enables the hyphens separating numbers to be copied without change.

To have the query refreshed when this block of code is run. Setting ".BackgroundQuery = False" makes it so that the code will block on the refresh call, so that it will wait until the query is done executing before continuing onto the rest of the code.

SAS Fifth Dimension Macro-Input Output

Review the following code, copy it to Excel and execute it.

Sub MLB_standings()
   'Copy MLB standings into spreadsheet
    SPORT_NAME = "mlb"
    SPORT_NAME = "nba"
    SPORT_NAME = "nfl"
    SPORT_NAME = "nhl"
    SELECTED_YEAR = "2011"
    SPORT_URL = "URL;http://sports.yahoo.com/" & SPORT_NAME & "/" & _
                "standings?type=regular&year=season_" & SELECTED_YEAR
    NXT = NXT + 1
    SHEET_NAME = ActiveSheet.Name
    Sheets(SHEET_NAME).Name = UCase(SPORT_NAME) & " standings" & "_" & SELECTED_YEAR
    With ActiveSheet.QueryTables.Add(Connection:=SPORT_URL, _
          .Name = SPORT_NAME & " standings"
          .RefreshStyle = xlInsertDeleteCells
          .RefreshPeriod = 0
          .WebFormatting = xlWebFormattingNone
          .WebDisableDateRecognition = True
          .WebSelectionType = xlSpecifiedTables
          .WebTables = "1,1"
          .BackgroundQuery = False
    End With
   'Set sheet name
    Selection.Delete Shift:=xlToLeft
   'Find first consecutive non blank cells in column A
    For II = 1 To 10
        If Cells(II, 1) <> "" Then
           NUM = NUM + 1
           If NUM = 2 Then Exit For
           NUM = 0
        End If
    TXT = "1:" & II - 2
   'Delete lines from first to before the consecutive non blank cells in column A
    Selection.Delete Shift:=xlUp
    Cells(1, 1).Select
End Sub