#1
|
|||
|
|||
Grabbing Historical NBA Data
I had nothing better to do so I figured I'd write up some code. If you want to input NBA data from 1993-1994 to 2005-2006 into Excel, just do this:
1. Open a new blank Excel workbook. Name the first sheet "1993-1994". 2. Put the following headers in: A1: "Date" B1: "Away" C1: "Home" D1: "Home Line" E1: "Total" F1: "Away Score" G1: "Home Score" (Change the column widths and alignments if you prefer) 3. Insert a web query for the 1993-1994 data. a) Select the N2 cell. b) Select Data | Import External Data | New Web Query. c) In the address bar, put http://www.goldsheet.com/historic/93nbalog.html d) Select "Go". When the page loads, select the arrow next to the first set of game listings. This should be the third arrow on the page, and just above the "ATLANTA HAWKS" line. Now all of the games should be highlighted, and the arrow should be a check mark. e) Select "Import". Select "Properties..." and clear the "Enable background refresh" checkbox. Select OK. f) Select OK. After a few seconds, the game data should appear in the sheet. 4. Create the macro. a) Open the Visual Basic editor (ALT + F11). b) In the left-hand pane, select "Module1" under "Modules". If "Module1" isn't there, right-click on "Microsoft Excel Object" and select Insert | Module. Now double-click on "Module1". c) In the blank page that appears, insert the macro code [to be posted in a followup]. 5. Insert a control button for the macro. a) Go back to the Excel window. Select View | Toolbars | Forms. b) The forms toolbar should appear. Select the button (right column, second from top). Draw a button in a convenient spot. I used cells H1-J1. c) After you're finished drawing the button, select the "getGames" macro in the macro window that appears. d) You can rename the caption of the button if you want to. 6. Copy the worksheets. a) Right-click on the worksheet tab on the bottom of the Excel window. Select "Move or Copy". Select the "create a copy" checkbox. Select OK. b) Repeat step (6a) 11 more times. c) Rename each sheet using the convention "YEAR1-YEAR2", e.g. "1996-1997" or "1999-2000". THIS STEP IS IMPORTANT BECAUSE THE MACRO USES THE SHEET LABEL TO DETERMINE THE APPROPRIATE DATES FOR THE GAMES. (To rename a sheet, right-click on the sheet's tab and select "Rename") 7. Edit the queries. (Right now, we have a bunch of worksheets, all with the 1993-1994 data) Go to each sheet in turn and do the following: a) Right-click somewhere in the imported data. Select "Edit Query". b) Edit the address of the query as follows: 1994-1995: http://www.goldsheet.com/historic/94nbalog.html 1995-1996: http://www.goldsheet.com/historic/nbalog95.html 1996-1997: http://www.goldsheet.com/historic/nbalog96.html 1997-1998: http://www.goldsheet.com/historic/nbalog97.html 1998-1999: http://www.goldsheet.com/historic/nbalog98.html 1999-2000: http://www.goldsheet.com/historic/nbalog99.html 2000-2001: http://www.goldsheet.com/historic/nbalog00.html 2001-2002: http://www.goldsheet.com/historic/nbalog01.html 2002-2003: http://www.goldsheet.com/historic/nbalog02.html 2003-2004: http://www.goldsheet.com/historic/nbalog03.html 2004-2005: http://www.goldsheet.com/historic/nbalog04.html 2005-2006: http://www.goldsheet.com/historic/nbalog05.html c) Select "Go" to update the web page. d1) For the seasons before 2001-2002, do the following: when the page loads, select the arrow next to the first set of game listings. This should be the third arrow on the page, and just above the "ATLANTA HAWKS" line. Now all of the games should be highlighted, and the arrow should be a check mark. d2) For seasons 2001-2002 and later, select the second arrow, which should include the "The Gold Sheet" logo. Make sure all of the games are selected, and that the arrow turns into a green check mark. d3) For the 1997-1998 and 2000-2001 seasons, you may need to use the first arrow instead of the third. Just make sure all the games are highlighted. e) Select Import. Make sure the data is updated. EXECUTION NOTES: - Just click the button on each sheet. The status bar should update progress - If "####" symbols appear in a column, just widen the column to accomodate the data. - A Spread of 999 or -999 means that there was no line given. - A Total of 0 means that there was no total given. - Random errors in input data: 1996-1997: on line 365 of the input data (May 28), the data for the next game (June 1) is on that line (there's a missing line return in the input data). Change the last cell of the line from "176O 6/1 Utah" to "176O". Delete the next line (it will have an "L" in the first column instead of a date). |
#2
|
|||
|
|||
Macro Code
<font class="small">Code:</font><hr /><pre>
Option Explicit Public Type Game eventDate As Date awayTeam As String homeTeam As String homeLine As Double finalScoreAway As Integer finalScoreHome As Integer totalLine As Double End Type Const INPUT_DATE_COLUMN As Integer = 1 Const INPUT_OPPONENT_COLUMN As Integer = 2 Const INPUT_SPREAD_DECISION_COLUMN As Integer = 3 Const INPUT_SPREAD_COLUMN As Integer = 4 Const INPUT_SCORE_COLUMN As Integer = 5 Const INPUT_HOME_OR_AWAY_COLUMN As Integer = 6 Const INPUT_TOTAL_COLUMN As Integer = 7 Const OUTPUT_DATE_COLUMN As Integer = 1 Const OUTPUT_AWAY_COLUMN As Integer = 2 Const OUTPUT_HOME_COLUMN As Integer = 3 Const OUTPUT_HOME_LINE_COLUMN As Integer = 4 Const OUTPUT_TOTAL_COLUMN As Integer = 5 Const OUTPUT_AWAY_SCORE_COLUMN As Integer = 6 Const OUTPUT_HOME_SCORE_COLUMN As Integer = 7 Sub getGames() Dim qt As QueryTable Dim rr As Range Dim tempRange As Range Dim row As Integer Dim strMainTeam As String Dim g As Game Dim startYear As Integer Dim outputRow As Integer Dim bOldStatusBar As Boolean Dim dPercentDone As Double Dim inputStartColumn As Integer Dim lineA As Integer Dim lineB As Integer Dim vTemp As Variant bOldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True outputRow = 2 startYear = getStartYearFromSheetName If startYear < 2001 Then inputStartColumn = 1 Else inputStartColumn = 3 End If Set qt = ActiveSheet.QueryTables(1) Set rr = qt.ResultRange If startYear > 2000 Then For row = 1 To rr.Rows.Count If InStr(UCase(rr.Cells(row, inputStartColumn)), "SUR") > 0 Then lineA = row Exit For End If Next row For row = lineA To rr.Rows.Count If Len(rr.Cells(row, inputStartColumn)) > 2 Then vTemp = Split(rr.Cells(row, inputStartColumn), " ") If UBound(vTemp) > 4 And IsDate(vTemp(0)) Then parseInputLine rr, row, inputStartColumn End If End If dPercentDone = 100 * (row / rr.Rows.Count) Application.StatusBar = "Formatting Input Data: " & CStr(Round(dPercentDone, 0)) & "% finished" Next row End If For row = 1 To rr.Rows.Count If InStr(UCase(rr.Cells(row, inputStartColumn)), "SUR") > 0 Then correctTeamName rr, row - 1, inputStartColumn strMainTeam = rr.Cells(row - 1, inputStartColumn) Else If IsDate(rr.Cells(row, inputStartColumn)) Then g = parseGame(rr, row, inputStartColumn, strMainTeam) g.eventDate = correctDate(g.eventDate, startYear) If False = findGame(g) Then pasteGame g, outputRow outputRow = outputRow + 1 End If End If End If dPercentDone = 100 * (row / rr.Rows.Count) Application.StatusBar = "Parsing Games: " & CStr(Round(dPercentDone, 0)) & "% finished" Next row sortGames Application.StatusBar = False Application.DisplayStatusBar = bOldStatusBar End Sub 'getGames Sub parseInputLine(rr As Range, row As Integer, col As Integer) Dim vArray As Variant Dim strdate As String Dim strOpponent As String Dim strDecision As String Dim strLine As String Dim strScore As String Dim strHomeOrAway As String Dim strTotal As String Dim strTemp As String Dim i As Integer Dim j As Integer vArray = Split(rr.Cells(row, col), " ") strdate = vArray(0) strTemp = "" strLine = "" For i = 1 To UBound(vArray) If Len(vArray(i)) = 1 Then Exit For ElseIf Len(vArray(i)) > 1 Then If IsNumeric(Left(vArray(i), 1)) Then strDecision = "" strLine = "NL" strScore = vArray(i) Exit For Else strTemp = strTemp & " " & vArray(i) End If End If Next i strOpponent = Trim(strTemp) If Len(strLine) < 2 Then strDecision = vArray(i) For j = i + 1 To UBound(vArray) If Len(vArray(j)) > 0 Then strLine = vArray(j) Exit For End If Next j For i = j + 1 To UBound(vArray) If Len(vArray(i)) > 0 Then strScore = vArray(i) Exit For End If Next i End If For j = i + 1 To UBound(vArray) If Len(vArray(j)) > 0 Then strHomeOrAway = vArray(j) Exit For End If Next j For i = j + 1 To UBound(vArray) If Len(vArray(i)) > 0 Then strTotal = vArray(i) Exit For End If Next i rr.Cells(row, col + INPUT_DATE_COLUMN - 1) = strdate rr.Cells(row, col + INPUT_OPPONENT_COLUMN - 1) = strOpponent rr.Cells(row, col + INPUT_SPREAD_DECISION_COLUMN - 1) = strDecision rr.Cells(row, col + INPUT_SPREAD_COLUMN - 1) = strLine rr.Cells(row, col + INPUT_SCORE_COLUMN - 1) = strScore rr.Cells(row, col + INPUT_HOME_OR_AWAY_COLUMN - 1) = strHomeOrAway rr.Cells(row, col + INPUT_TOTAL_COLUMN - 1) = strTotal End Sub 'parseInputLine Sub sortGames() Dim rng As Range Set rng = ActiveSheet.Range("A2:H1400") rng.Sort ActiveSheet.Columns(1), xlAscending, ActiveSheet.Columns(2) End Sub 'sortGames Sub pasteGame(g As Game, row As Integer) ActiveSheet.Cells(row, OUTPUT_DATE_COLUMN) = g.eventDate ActiveSheet.Cells(row, OUTPUT_AWAY_COLUMN) = g.awayTeam ActiveSheet.Cells(row, OUTPUT_HOME_COLUMN) = g.homeTeam ActiveSheet.Cells(row, OUTPUT_HOME_LINE_COLUMN) = g.homeLine ActiveSheet.Cells(row, OUTPUT_TOTAL_COLUMN) = g.totalLine ActiveSheet.Cells(row, OUTPUT_AWAY_SCORE_COLUMN) = g.finalScoreAway ActiveSheet.Cells(row, OUTPUT_HOME_SCORE_COLUMN) = g.finalScoreHome End Sub 'pasteGame Function findGame(g As Game) As Boolean Dim i As Integer Dim blnFlag As Boolean For i = 2 To 6000 If False = IsDate(ActiveSheet.Cells(i, OUTPUT_DATE_COLUMN)) Then Exit For End If blnFlag = True If ActiveSheet.Cells(i, OUTPUT_DATE_COLUMN) <> g.eventDate Then blnFlag = False ElseIf ActiveSheet.Cells(i, OUTPUT_AWAY_COLUMN) <> g.awayTeam Then blnFlag = False ElseIf ActiveSheet.Cells(i, OUTPUT_HOME_COLUMN) <> g.homeTeam Then blnFlag = False End If If True = blnFlag Then findGame = True Exit Function End If Next i findGame = False End Function 'findGame Function parseGame(rngData As Range, row As Integer, col As Integer, strMainTeam As String) As Game Dim retGame As Game Dim strSpread As String Dim strTotal As String Dim dblSpread As Double Dim scoreA As Integer Dim scoreB As Integer Dim intDashPos As Integer Dim vArray As Variant Dim i As Integer strSpread = Replace(rngData.Cells(row, col + INPUT_SPREAD_COLUMN - 1), "'", "") If InStr(rngData.Cells(row, col + INPUT_SPREAD_COLUMN - 1), "NL") > 0 Or Len(rngData.Cells(row, col + INPUT_SPREAD_COLUMN - 1)) = 0 Then dblSpread = 999 ElseIf InStr(rngData.Cells(row, col + INPUT_SPREAD_COLUMN - 1), "P") > 0 Then dblSpread = 0 Else dblSpread = strSpread End If If InStr(rngData.Cells(row, col + INPUT_SPREAD_COLUMN - 1), "'") > 0 Then If InStr(rngData.Cells(row, col + INPUT_SPREAD_COLUMN - 1), "-") > 0 Then dblSpread = dblSpread - 0.5 Else dblSpread = dblSpread + 0.5 End If End If If Left(rngData.Cells(row, col + INPUT_SCORE_COLUMN - 1), 1) = "'" Then If dblSpread < 0 Then dblSpread = dblSpread - 0.5 Else dblSpread = dblSpread + 0.5 End If rngData.Cells(row, col + INPUT_SCORE_COLUMN - 1) = Trim(Replace(rngData.Cells(row, col + INPUT_SCORE_COLUMN - 1), "'", "")) End If intDashPos = InStr(rngData.Cells(row, col + INPUT_SCORE_COLUMN - 1), "-") scoreA = Left(rngData.Cells(row, col + INPUT_SCORE_COLUMN - 1), intDashPos - 1) scoreB = Mid(rngData.Cells(row, col + INPUT_SCORE_COLUMN - 1), intDashPos + 1) retGame.eventDate = rngData.Cells(row, col + INPUT_DATE_COLUMN - 1) If InStr(rngData.Cells(row, col + INPUT_HOME_OR_AWAY_COLUMN - 1), "H") > 0 Then retGame.homeTeam = strMainTeam retGame.awayTeam = rngData.Cells(row, col + INPUT_OPPONENT_COLUMN - 1) retGame.homeLine = dblSpread retGame.finalScoreAway = scoreB retGame.finalScoreHome = scoreA Else retGame.homeTeam = rngData.Cells(row, col + INPUT_OPPONENT_COLUMN - 1) retGame.awayTeam = strMainTeam retGame.homeLine = -dblSpread retGame.finalScoreAway = scoreA retGame.finalScoreHome = scoreB End If If InStr(rngData.Cells(row, col + INPUT_TOTAL_COLUMN - 1), "NL") > 0 Then retGame.totalLine = 0 Else vArray = Split(Trim(rngData.Cells(row, col + INPUT_TOTAL_COLUMN - 1)), " ") strTotal = rngData.Cells(row, col + INPUT_TOTAL_COLUMN - 1) If UBound(vArray) > 0 Then For i = 0 To UBound(vArray) If InStr(vArray(i), "O") > 0 Or InStr(vArray(i), "U") > 0 Or InStr(vArray(i), "N") > 0 Then strTotal = vArray(i) Exit For End If Next i End If strTotal = Replace(strTotal, "O", "") strTotal = Replace(strTotal, "U", "") strTotal = Trim(Replace(strTotal, "N", "")) retGame.totalLine = strTotal End If parseGame = retGame End Function 'parseGame Sub correctTeamName(rngData As Range, row As Integer, col As Integer) If InStr(UCase(rngData.Cells(row, col)), "ATLAN") > 0 Then rngData.Cells(row, col) = "Atlanta" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "BOSTO") > 0 Then rngData.Cells(row, col) = "Boston" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "CHARL") > 0 Then rngData.Cells(row, col) = "Charlotte" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "CHICA") > 0 Then rngData.Cells(row, col) = "Chicago" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "CLEVE") > 0 Then rngData.Cells(row, col) = "Cleveland" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "DALLA") > 0 Then rngData.Cells(row, col) = "Dallas" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "DENVE") > 0 Then rngData.Cells(row, col) = "Denver" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "DETRO") > 0 Then rngData.Cells(row, col) = "Detroit" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "GOLDE") > 0 Then rngData.Cells(row, col) = "Golden St." rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "HOUST") > 0 Then rngData.Cells(row, col) = "Houston" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "INDIA") > 0 Then rngData.Cells(row, col) = "Indiana" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "LOS A") > 0 Then If InStr(UCase(rngData.Cells(row, col + 1)), "CLIPPERS") > 0 Or InStr(UCase(rngData.Cells(row, col)), "CLIPPERS") > 0 Then rngData.Cells(row, col) = "LA Clippers" rngData.Cells(row, col + 1) = "" Else rngData.Cells(row, col) = "LA Lakers" rngData.Cells(row, col + 1) = "" End If ElseIf InStr(UCase(rngData.Cells(row, col)), "MEMPH") > 0 Then rngData.Cells(row, col) = "Memphis" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "MIAMI") > 0 Then rngData.Cells(row, col) = "Miami" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "MILWA") > 0 Then rngData.Cells(row, col) = "Milwaukee" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "MINNE") > 0 Then rngData.Cells(row, col) = "Minnesota" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "NEW J") > 0 Then rngData.Cells(row, col) = "New Jersey" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "NEW O") > 0 Then rngData.Cells(row, col) = "N. Orleans" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "N. OR") > 0 Then If InStr(UCase(rngData.Cells(row, col)), "CITY") > 0 Then rngData.Cells(row, col) = "NO/OKC" rngData.Cells(row, col + 1) = "" Else rngData.Cells(row, col) = "N. Orleans" rngData.Cells(row, col + 1) = "" End If ElseIf InStr(UCase(rngData.Cells(row, col)), "NEW Y") > 0 Then rngData.Cells(row, col) = "New York" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "ORLAN") > 0 Then rngData.Cells(row, col) = "Orlando" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "PHILA") > 0 Then rngData.Cells(row, col) = "Philadelphia" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "PHOEN") > 0 Then rngData.Cells(row, col) = "Phoenix" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "PORTL") > 0 Then rngData.Cells(row, col) = "Portland" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "SACRA") > 0 Then rngData.Cells(row, col) = "Sacramento" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "SAN A") > 0 Then rngData.Cells(row, col) = "San Antonio" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "SEATT") > 0 Then rngData.Cells(row, col) = "Seattle" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "TORON") > 0 Then rngData.Cells(row, col) = "Toronto" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "UTAH") > 0 Then rngData.Cells(row, col) = "Utah" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "VANC") > 0 Then rngData.Cells(row, col) = "Vancouver" rngData.Cells(row, col + 1) = "" ElseIf InStr(UCase(rngData.Cells(row, col)), "WASHI") > 0 Then rngData.Cells(row, col) = "Washington" rngData.Cells(row, col + 1) = "" End If End Sub 'correctTeamName Function correctDate(d As Date, y As Integer) As Date Dim retDate As Date If Month(d) > 8 Then retDate = DateSerial(y, Month(d), Day(d)) Else retDate = DateSerial(y + 1, Month(d), Day(d)) End If correctDate = retDate End Function Function getStartYearFromSheetName() Dim strSheetLabel As String Dim intDashPos As Integer strSheetLabel = ActiveSheet.Name intDashPos = InStr(strSheetLabel, "-") If Null = intDashPos Or 0 = intDashPos Then MsgBox "Can't determine appropriate year for this sheet" getStartYearFromSheetName = 1900 Return End If getStartYearFromSheetName = Left(strSheetLabel, intDashPos - 1) End Function 'getStartYearFromSheetName </pre><hr /> |
#3
|
|||
|
|||
Re: Grabbing Historical NBA Data
Bravo! Thanks for sharing.
|
#4
|
|||
|
|||
Re: Grabbing Historical NBA Data
[ QUOTE ]
I had nothing better to do so I figured I'd write up some code. [/ QUOTE ] I had nothing better to do so I figured I'd come up with a cure for cancer. OK, maybe this isn't quite that dramatic, but dang, this is fabulous work. Thank you so much. It dovetails perfectly with a project I'm working on. lordfoo, you are my new personal hero. |
#5
|
|||
|
|||
Re: Grabbing Historical NBA Data
just wanted to bump this thread to say ty, sweet deal!
|
#6
|
|||
|
|||
Re: Grabbing Historical NBA Data
bump this is quite awesome and better at teaching embedded code in excel than any durrr-ish virginia tech business school course i ever took
|
#7
|
|||
|
|||
Re: Grabbing Historical NBA Data
You da man! Too sweeeeeeettttttt!
|
#8
|
|||
|
|||
Re: Grabbing Historical NBA Data
Great contribution to the forum, LordFoo
|
|
|