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 Workbooks.Add SHEET_NAME = ActiveSheet.Name Sheets(SHEET_NAME).Name = UCase(SPORT_NAME) & " standings" & "_" & SELECTED_YEAR With ActiveSheet.QueryTables.Add(Connection:=SPORT_URL, _ Destination:=Range("$A$1")) .Name = SPORT_NAME & " standings" .RefreshStyle = xlInsertDeleteCells .RefreshPeriod = 0 .WebFormatting = xlWebFormattingNone .WebDisableDateRecognition = True .WebSelectionType = xlSpecifiedTables .WebTables = "1,1" .BackgroundQuery = False .Refresh End With 'Set sheet name Columns("M:Q").Select 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 Else NUM = 0 End If Next TXT = "1:" & II - 2 'Delete lines from first to before the consecutive non blank cells in column A Rows(TXT).Select Selection.Delete Shift:=xlUp Cells(1, 1).Select End Sub