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).

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 &lt; 2001 Then
inputStartColumn = 1
Else
inputStartColumn = 3
End If
Set qt = ActiveSheet.QueryTables(1)
Set rr = qt.ResultRange
If startYear &gt; 2000 Then
For row = 1 To rr.Rows.Count
If InStr(UCase(rr.Cells(row, inputStartColumn)), "SUR") &gt; 0 Then
lineA = row
Exit For
End If
Next row
For row = lineA To rr.Rows.Count
If Len(rr.Cells(row, inputStartColumn)) &gt; 2 Then
vTemp = Split(rr.Cells(row, inputStartColumn), " ")
If UBound(vTemp) &gt; 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: " &amp; CStr(Round(dPercentDone, 0)) &amp; "% finished"
Next row


End If
For row = 1 To rr.Rows.Count
If InStr(UCase(rr.Cells(row, inputStartColumn)), "SUR") &gt; 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: " &amp; CStr(Round(dPercentDone, 0)) &amp; "% 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)) &gt; 1 Then
If IsNumeric(Left(vArray(i), 1)) Then
strDecision = ""
strLine = "NL"
strScore = vArray(i)
Exit For
Else
strTemp = strTemp &amp; " " &amp; vArray(i)
End If
End If
Next i
strOpponent = Trim(strTemp)
If Len(strLine) &lt; 2 Then
strDecision = vArray(i)
For j = i + 1 To UBound(vArray)
If Len(vArray(j)) &gt; 0 Then
strLine = vArray(j)
Exit For
End If
Next j
For i = j + 1 To UBound(vArray)
If Len(vArray(i)) &gt; 0 Then
strScore = vArray(i)
Exit For
End If
Next i
End If

For j = i + 1 To UBound(vArray)
If Len(vArray(j)) &gt; 0 Then
strHomeOrAway = vArray(j)
Exit For
End If
Next j

For i = j + 1 To UBound(vArray)
If Len(vArray(i)) &gt; 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) &lt;&gt; g.eventDate Then
blnFlag = False
ElseIf ActiveSheet.Cells(i, OUTPUT_AWAY_COLUMN) &lt;&gt; g.awayTeam Then
blnFlag = False
ElseIf ActiveSheet.Cells(i, OUTPUT_HOME_COLUMN) &lt;&gt; 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") &gt; 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") &gt; 0 Then
dblSpread = 0
Else
dblSpread = strSpread
End If
If InStr(rngData.Cells(row, col + INPUT_SPREAD_COLUMN - 1), "'") &gt; 0 Then
If InStr(rngData.Cells(row, col + INPUT_SPREAD_COLUMN - 1), "-") &gt; 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 &lt; 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") &gt; 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") &gt; 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) &gt; 0 Then
For i = 0 To UBound(vArray)
If InStr(vArray(i), "O") &gt; 0 Or InStr(vArray(i), "U") &gt; 0 Or InStr(vArray(i), "N") &gt; 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") &gt; 0 Then
rngData.Cells(row, col) = "Atlanta"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "BOSTO") &gt; 0 Then
rngData.Cells(row, col) = "Boston"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "CHARL") &gt; 0 Then
rngData.Cells(row, col) = "Charlotte"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "CHICA") &gt; 0 Then
rngData.Cells(row, col) = "Chicago"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "CLEVE") &gt; 0 Then
rngData.Cells(row, col) = "Cleveland"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "DALLA") &gt; 0 Then
rngData.Cells(row, col) = "Dallas"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "DENVE") &gt; 0 Then
rngData.Cells(row, col) = "Denver"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "DETRO") &gt; 0 Then
rngData.Cells(row, col) = "Detroit"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "GOLDE") &gt; 0 Then
rngData.Cells(row, col) = "Golden St."
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "HOUST") &gt; 0 Then
rngData.Cells(row, col) = "Houston"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "INDIA") &gt; 0 Then
rngData.Cells(row, col) = "Indiana"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "LOS A") &gt; 0 Then
If InStr(UCase(rngData.Cells(row, col + 1)), "CLIPPERS") &gt; 0 Or InStr(UCase(rngData.Cells(row, col)), "CLIPPERS") &gt; 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") &gt; 0 Then
rngData.Cells(row, col) = "Memphis"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "MIAMI") &gt; 0 Then
rngData.Cells(row, col) = "Miami"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "MILWA") &gt; 0 Then
rngData.Cells(row, col) = "Milwaukee"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "MINNE") &gt; 0 Then
rngData.Cells(row, col) = "Minnesota"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "NEW J") &gt; 0 Then
rngData.Cells(row, col) = "New Jersey"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "NEW O") &gt; 0 Then
rngData.Cells(row, col) = "N. Orleans"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "N. OR") &gt; 0 Then
If InStr(UCase(rngData.Cells(row, col)), "CITY") &gt; 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") &gt; 0 Then
rngData.Cells(row, col) = "New York"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "ORLAN") &gt; 0 Then
rngData.Cells(row, col) = "Orlando"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "PHILA") &gt; 0 Then
rngData.Cells(row, col) = "Philadelphia"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "PHOEN") &gt; 0 Then
rngData.Cells(row, col) = "Phoenix"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "PORTL") &gt; 0 Then
rngData.Cells(row, col) = "Portland"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "SACRA") &gt; 0 Then
rngData.Cells(row, col) = "Sacramento"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "SAN A") &gt; 0 Then
rngData.Cells(row, col) = "San Antonio"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "SEATT") &gt; 0 Then
rngData.Cells(row, col) = "Seattle"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "TORON") &gt; 0 Then
rngData.Cells(row, col) = "Toronto"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "UTAH") &gt; 0 Then
rngData.Cells(row, col) = "Utah"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "VANC") &gt; 0 Then
rngData.Cells(row, col) = "Vancouver"
rngData.Cells(row, col + 1) = ""
ElseIf InStr(UCase(rngData.Cells(row, col)), "WASHI") &gt; 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) &gt; 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 />

Re: Grabbing Historical NBA Data
 

Bravo! Thanks for sharing.

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.

Re: Grabbing Historical NBA Data
 

just wanted to bump this thread to say ty, sweet deal!

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

Re: Grabbing Historical NBA Data
 

You da man! Too sweeeeeeettttttt!

Re: Grabbing Historical NBA Data
 

Great contribution to the forum, LordFoo