How'd They Do That: Realtime World Cup Scores

world cup logo

World Cup fever is here!

soccer ballsoccer field

In FIFA Worldcup Excel Spreadsheets Roundup, Chandoo has some links to useful World Cup tracking workbooks. Only one of them (the first one) can update scores for you, but the workbook code is locked. I'm not sure what method it uses, but here's one way to get realtime scores for your World Cup 2010 tracking workbook.

Realtime Scores from Twitter

I found a Twitter account that publishes scores for many different soccer games and leagues around the world. So we can parse the RSS feed and look for World Cup scores.

We'll use the same techniques as we've seen elsewhere (see Bing Translation, The Bible In Excel, Tweet Shortener) — call a web service and cache the response, then parse it using the MSXML2 Object Model.

The GetFinalScores Function

The following function will return any final World Cup scores available from the aforementioned Twitter feed. You'll need to poll the feed pretty regularly, because it only contains about 20-30 items and updates often with unrelated scores, red cards and so on. The feed is cached in the local temp folder in a file called "finalscores.xml". Don't forget to include the helper functions in your VBA project.

Once the function is run, you'll need to force it to refresh the data by passing a parameter of True, and of course you'll need to store previous data once new data comes in. Let's see the function and then we'll dissect how it works.

Function GetFinalScores(Optional forceRequery As Boolean = False) As String()

Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFile As String
Dim tempString() As String
Dim numRows As Long
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim rss As Object ' MSXML2.IXMLDOMNode
Dim channel As Object ' MSXML2.IXMLDOMNode
Dim items As Object ' MSXML2.IXMLDOMNodeList
Dim i As Long
Dim score As String
Dim startString As Long
Dim endString As Long
Dim firstTeam As String
Dim secondTeam As String
Dim finalScore As String
Dim ilCounter As Long

Const numCols As Long = 3   ' two teams plus score = 3 columns

  tempFile = environ("temp") & "\finalscores.xml"

  If (Len(Dir(tempFile)) = 0 Or forceRequery) Then

    Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

    xml.Open "GET", "", False

    result = ConvertAccent(xml.responseText)

    ' create XML file from result
    Call CreateFile(tempFile, result)

  End If

  ' create XML doc
  Set xmlDoc = CreateObject("MSXML2.DOMDocument")

  With xmlDoc
    .async = False
    .validateOnParse = False
    .Load tempFile
  End With

  ' check that the XML doc loaded
  If LoadError(xmlDoc) Then
    Exit Function
  End If

  ' get first level node
  Set rss = xmlDoc.childNodes(1)
  ' get second level node
  Set channel = rss.childNodes(0)
  ' get items nodes
  Set items = GetChildNodes(channel)

  ' count number of available scores
  ' start loop at item #6, first five nodes are useless
  For i = 1 To items.Length - 6
    score = items.item(i + 5).childNodes.item(0).nodeTypedValue

    ' look for "Full Time" to get final scores
    If InStr(score, "Live soccer scores: Full Time") > 0 Then
      ' look for "World Cup"
      If InStr(score, "World Cup") > 0 Then
        ' add to total
        numRows = numRows + 1
      End If
    End If
  Next i

  ' resize array
  ReDim tempString(1 To numRows, 1 To numCols)

  ' reloop through XML, add data to array
  ' start loop at item #6, first five nodes are useless
  For i = 1 To items.Length - 6
    score = items.item(i + 5).childNodes.item(0).nodeTypedValue

    ' look for "Full Time" to get final scores
    If InStr(score, "Live soccer scores: Full Time") > 0 Then
      ' look for "World Cup"
      If InStr(score, "World Cup") > 0 Then

        ' start internal loop counter
        ilCounter = ilCounter + 1

        ' parse first team name
        startString = InStr(score, "Live soccer scores: Full Time") + 30
        endString = InStr(startString, score, "[")
        firstTeam = Mid$(score, startString, endString - startString - 1)

        ' parse second team name
        startString = InStr(score, "]") + 2
        endString = InStr(startString, score, "World Cup")
        secondTeam = Mid$(score, startString, endString - startString - 1)

        ' parse final score
        startString = InStr(score, "[") + 1
        endString = InStr(startString, score, "]")
        finalScore = Mid$(score, startString, endString - startString)

        tempString(ilCounter, 1) = firstTeam
        tempString(ilCounter, 2) = secondTeam
        tempString(ilCounter, 3) = finalScore

      End If
    End If

  Next i

  GetFinalScores = tempString

End Function

There are two loops used here. The first loop counts how many World Cup final scores are available in the feed. It's a bit clumsy because we have to start at node number six to start getting the sub-nodes that have the information we need.

Essentially all the World Cup final score nodes have the same information: they all say "Live soccer scores: Full Time" and "World Cup" in them. So it's a simple matter of using InStr to look for each string, and adding one to the count as each matching node is found.

I realize I could use ReDim Preserve and just use one loop (and I might do so in a future post) but I avoid it not just because of the performance hit, but mostly because I don't use it much and don't feel like re-learning it.

After we get the count of nodes we need, we loop through them again. The loop is exactly the same, except this time we parse the first node (childNodes.item(0).nodeTypedValue) for the team names and the score. These are assigned to the next slot in the array.

Sample Usage

Sub GetScores()

Dim i As Long, j As Long
Dim results() As String

  results = GetFinalScores
  For i = LBound(results) To UBound(results)
    For j = LBound(results, 2) To UBound(results, 2)
      Debug.Print results(i, j)
    Next j
  Next i

End Sub

Helper Functions

In order for the GetFinalScores function to work, you'll need to include these helper functions in a standard module in the same project. Note the change in the FixAngleBrackets function, due to the way Twitter passes quotation marks in their feeds.

Function FixAngleBrackets(textString As String) As String
  FixAngleBrackets = Replace(Replace(textString, "&lt;", "<"), "&gt;", ">")
  ' also need to fix HTML &quot; character for Twitter
  FixAngleBrackets = Replace(FixAngleBrackets, "&quot;", """")
End Function

Game on!

soccer ball

About JP

I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space to learn more about VBA. Keep Reading »

Share This Article:

Share and bookmark this articledelicious buttonfacebook buttonlinkedin buttonstumbleupon buttontwitter button

comment bubble 1 Comment(s) on How'd They Do That: Realtime World Cup Scores:

  1. Jeremy writes:

    This is the coolest Excel file I've ever seen.

This article is closed to any future comments.
Random Data Generator