Excel VBA - parse JSON string and set cell values based on key:values

Mathewjl
December 30, 2023
128 views
0 votes
2 Answers

I have an Excel spreadsheet with columns:

    |      A     |    B   |      C     |      D     |
    | Job number | Status | Actual Hrs | % Complete |
1___|____________|________|____________|____________|
2___|____________|________|____________|____________|

I have a macro to obtain the following string from an external web API:

[{
  "jobnumber":"123",
  "status":"Active",
  "actualhrs":"133",
  "completion":"94"},
{
  "jobnumber":"124",
  "status":"Active",
  "actualhrs":"13",
  "completion":"5"},
  ...
]

The string will contain hundreds of jobs. I am stumped trying to parse the response as an object in ExcelVBA to then populate rows in a spreadsheet.

Does anyone have any pointers for me? I realise I haven’t got any VBA code shown, but to be honest I’m going in circles.

I have tried Dim data as Object.
For each loop through the object.

Answers

You can use VBA-JSON. Here is sample code:

Sub ParseJSONAndPopulateSheet()
    ' Declare variables
    Dim json As String
    Dim jsonObj As Object
    Dim i As Integer
    Dim jobData As Object
    Dim rowData As Variant
    
    ' Replace this with your actual JSON string received from the API
    json = "[{""jobnumber"":""123"",""status"":""Active"",""actualhrs"":""133"",""completion"":""94""},{""jobnumber"":""124"",""status"":""Active"",""actualhrs"":""13"",""completion"":""5""}]"
    
    ' Parse JSON string to object
    Set jsonObj = JsonConverter.ParseJson(json)
    
    ' Loop through each object in the JSON array
    For i = 1 To jsonObj.Count
        Set jobData = jsonObj(i)
        
        ' Get job data
        rowData = Array(jobData("jobnumber"), jobData("status"), jobData("actualhrs"), jobData("completion"))
        
        ' Populate spreadsheet with job data
        With ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with your sheet name
            .Cells(i + 1, 1).Resize(1, UBound(rowData) + 1).Value = rowData
        End With
    Next i
End Sub

Here is the sample output from above code:

Notes:
Don’t forget to check Installation Guide

Download JsonConverter.bas from https://github.com/VBA-tools/VBA-JSON
Import JsonConverter.bas into the workbook
Add Scripting reference (VBE Tools>Reference, check Microsoft Scripting Runtime)
Store all JSON data in an array and write the output to the sheet all at once to improve efficiency

Option Explicit

Sub JsonData()
    Dim jsonStr As String, oJson, vKey
    Dim JsonParse As Object
    Dim iR As Long, iC As Long, arrRes()
    jsonStr = [a1] ' JSON string, modify as needed
    Set JsonParse = JsonConverter.ParseJson(jsonStr)
    If Not JsonParse Is Nothing Then
        ReDim arrRes(JsonParse.Count, 1 To JsonParse(1).Count)
        iR = 0
        iC = 0
        For Each vKey In Split("Job number|Status|Actual Hrs|% Complete", "|")
            iC = iC + 1
            arrRes(iR, iC) = vKey
        Next
        For Each oJson In JsonParse
            iC = 0
            iR = iR + 1
            For Each vKey In oJson
                iC = iC + 1
                arrRes(iR, iC) = oJson(vKey)
            Next
        Next
        Sheets.Add
        Range("A1").Resize(iR + 1, iC).Value = arrRes
    End If
End Sub

A pure VBA way to parse json data
Note:
The code may lead to a runtime error if the JSON data is invalid due to the absence of JSON validation.

Option Explicit

Sub JsonData2()
    Dim jsonStr As String
    Dim iR As Long, iC As Long, arrRes()
    Dim aData, vItem, vKey, vJson
    ' Remove space, newline, header and trailer chars
    jsonStr = Replace(Replace([a1], Chr(10), ""), Chr(32), "")
    jsonStr = Replace(Mid(jsonStr, 3, Len(jsonStr) - 4), Chr(34), "")
    ' Split json data
    aData = Split(jsonStr, "},{")
    ReDim arrRes(UBound(aData) + 1, 1 To 4)
    iR = 0
    iC = 0
    ' Populate header
    For Each vKey In Split("Job number|Status|Actual Hrs|% Complete", "|")
        iC = iC + 1
        arrRes(iR, iC) = vKey
    Next
    ' Extract json data
    For Each vJson In aData
        iR = iR + 1
        iC = 0
        For Each vItem In Split(vJson, ",")
            iC = iC + 1
            arrRes(iR, iC) = Split(vItem, ":")(1)
        Next
    Next
    ' Write output to sheet
    Sheets.Add
    Range("A1").Resize(iR + 1, iC).Value = arrRes
End Sub

Please signup or login to give your own answer.

Click here to cancel reply.

Excel VBA – parse JSON string and set cell values based on key:values

Answers