Can Excel 2007 import from JSON data in real-time?

d0rian

Active Member
Joined
May 30, 2015
Messages
313
Office Version
  1. 365
I'm trying to create a file that pulls in real-time golf scores -- the PGA tour site appears to provide data JSON format (which I've never worked with) here: https://statdata.pgatour.com/r/014/leaderboard-v2mini.json

I don't quite know how to parse that wall of text for use in Excel 2007. Later versions appear to have the ability to connect directly to JSON data(?) but I'm not sure if that's simply not possible in Excel 2007.

I could probably download that text data and cobble together some method to paste it raw into a sheet and write functions to parse it into a reader-friendly format...but that wouldn't be a "live" solution that updates itself in real-time. Is that possible?
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
You're correct that Excel 2010+ can import and parse JSON data directly via Power Query. For Excel 2007, you'll need custom VBA code to request the data using XMLhttp and a VBA JSON parser to parse it.

The following code (Extract_Leaderboard_Data) requests the JSON data and extracts the details of the first 20 players from it. You will need a workbook with sheets named "Leaderboard" and "JSON".

First, copy and paste the JSON.bas code from https://github.com/omegastripes/VBA-JSON-parser into a standard module. Delete the first line (Attribute ...), otherwise it won't compile.

Next, put the following code in another standard module.

Code:
Public Sub Extract_Leaderboard_Data()

    Dim httpReq As Object
    Dim URL As String
    Dim JSONall As Variant
    Dim parseState As String
    Dim destCell As Range
    Dim i As Long
    Dim player As Variant
    
    With ThisWorkbook.Worksheets("Leaderboard")
        .Cells.Clear
        .Range("A1:F1").Value = Array("Pos", "U/D", "Player", "Total", "Hole", "Round")
        Set destCell = .Range("A2")
    End With
    
    URL = "https://statdata.pgatour.com/r/014/leaderboard-v2mini.json"
    
    Set JSONall = Nothing
    Set httpReq = CreateObject("MSXML2.XMLHTTP")
    With httpReq
        .Open "GET", URL, False
        .Send
        If .Status = 200 Then
            'Debug.Print .responseText
            Parse .responseText, JSONall, parseState
            If parseState = "Error" Then
                MsgBox "Error parsing JSON data"
                Exit Sub
            End If
        End If
    End With
    
    With ThisWorkbook.Worksheets("JSON")
        If IsEmpty(.Range("A1").Value) Then 
            .Cells.Clear
            JSONToCells JSONall, .Range("A1")
        End If
    End With

    destCell.Worksheet.Range("G1").Value = "Data last updated " & Right(JSONall("last_updated"), 8)
    
    For i = 0 To 19
        Set player = JSONall("leaderboard")("players")(i)
        destCell.Offset(i, 0).Value = CvtPos(player("current_position"))
        destCell.Offset(i, 1).Value = CvtPos(player("start_position")) - CvtPos(player("current_position"))
        destCell.Offset(i, 2).Value = player("player_bio")("first_name") & " " & player("player_bio")("last_name")
        destCell.Offset(i, 3).Value = player("total")
        destCell.Offset(i, 4).Value = player("thru")
        destCell.Offset(i, 5).Value = player("today")
    Next
           
End Sub


Private Function CvtPos(ByVal pos As String) As Integer
    'Convert position string (which may be prefixed with "T" for 'tied') to its numeric value
    If Val(pos) = 0 Then
        CvtPos = Mid(pos, 2)
    Else
        CvtPos = pos
    End If
End Function


Private Function JSONToCells(JSONvar As Variant, destCell As Range, Optional ByVal path As String) As Long

    Dim n As Long
    Dim key As Variant
    Dim i As Long
    
    'Output parsed JSON data to Excel cells in a hierarchical layout
    
    n = 0
    
    If varType(JSONvar) = vbObject Then 'Dictionary
        
        For Each key In JSONvar.keys
            'Debug.Print key
            destCell.Offset(n, 0).Value = key
            n = n + JSONToCells(JSONvar.item(key), destCell.Offset(n, 1), path & "(" & key & ")")
        Next
    
    ElseIf varType(JSONvar) >= vbArray Then 'Variant()
                
        For i = 0 To UBound(JSONvar)
            'Debug.Print i
            destCell.Offset(n, 0).Value = i
            n = n + JSONToCells(JSONvar(i), destCell.Offset(n, 1), path & "(" & i & ")")
        Next
        
    Else
        
        'Debug.Print JSONvar
        destCell.Offset(n, 0).Value = JSONvar
        CreateComment destCell.Offset(n, 0), path
        n = n + 1
        
    End If

    JSONToCells = n
    
End Function


Private Sub CreateComment(cell As Range, commentText As String)
        
    With cell
        If .Comment Is Nothing Then .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=commentText
        .Comment.Shape.TextFrame.AutoSize = True
    End With
    
End Sub
Run the Extract_Leaderboard_Data macro to get the latest leaderboard data. You might need to sort it by column A (Position) because the players are extracted in the same order as they appear in the JSON data, and the Position value in column A is obtained from the current_position field. To update the leaderboard in 'real-time' you would have to periodically run the macro or call it with an Application.OnTime timer.

The macro calls the JSONToCells function which outputs the JSON data to the JSON sheet in a hierarchical layout, helping you to understand the structure of the data. Notice that each data value cell has a cell comment showing the 'path' to that data.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,972
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top