extract maximum of a json array in excel VBA without iterating

Question

I have JSON data string from which I try to extract the highest value of "id" without iterating.

This is the JSON data string:

        "ball_coordinates": [
            {
                "id": 3938706,
                "fixture_id": 18795544,
                "period_id": 4644037,
                "timer": "17:20",
                "x": "106",
                "y": "57"
            },
            {
                "id": 3938771,
                "fixture_id": 18795544,
                "period_id": 4644037,
                "timer": "18:17",
                "x": "15",
                "y": "75"
            },
            {
                "id": 3939282,
                "fixture_id": 18795544,
                "period_id": 4644037,
                "timer": "28:47",
                "x": "21",
                "y": "19"
            },
            {
                "id": 3938083,
                "fixture_id": 18795544,
                "period_id": 4644037,
                "timer": "3:28",
                "x": "8",
                "y": "77"
            }
        ]
    },

The highest id is 3939282.

In the post below I noticed it is possible to count the items in a part of a JSON string:

size of an array excel - json vba parser

If I change var.Count to var.Max it works too.

If I try to implement this method in my own Excel VBA code in the way below, it gives an error at line two (starting with Set myvar).

Dim myvar As Object
    Set myvar = item("ball_coordinates")("id")
    Debug.Print myvar.Count
    Debug.Print WorksheetFunction.Max(myvar)

The error is: Run-time error 5: Invalid procedure call or argument.

I have the JsonConvertor-code activated in this workbook which runs fine.

I suppose the reason is that the id's are spread over all elements and not within one element as is the case in the other post.

Is there any way to overcome this?

Thanks a lot!

EDIT:

The reason for my question is that I try to increase the speed of my code. If I use the code below with iteration it takes 9 seconds to process 30k ball_coordinates.

highest_bal_id = 0
bal_timer = "NA"
bal_x = "NA"
bal_y = "NA"


For Each bal In item("ball_coordinates")

    bal_id = bal("id")
    If bal_id > highest_bal_id Then
    
        bal_timer = bal("timer")
        bal_x = bal("x")
        bal_y = bal("y")
        highest_bal_id = bal_id
    
    End If
    
Next

EDIT 2:

I also tried the alternative code below to see if this is faster. Although I do not succeed to access item("ball_coordinates")("id") based on the highest_ball_id. I do not know if it is possible to access it as a dictionary or collection with a key based on highest_ball_id.

teller = 1

For Each bal In item("ball_coordinates")

    temp_array(teller) = bal("id")
    teller = teller + 1
    
Next

highest_ball_id = WorksheetFunction.Max(temp_array)

Debug.Print item("ball_coordinates")("id"); highest_ball_id

EDIT 3

The json data string is nesting from a larger string. The data is from an API and generated with this code:

Dim http As Object, json As Object, i As Integer, item As Object
Dim APIString As String
Set http = CreateObject("MSXML2.XMLHTTP")
APIString = "https://api.com/livescores/inplay?api_token=__&include=periods;scores;participants;ballCoordinates"
    http.Open "GET", APIString, True
    http.send

Set json = ParseJson(http.responseText)

For Each item In json("data")

    'read every item for periods, scores, participants, ballCoordinates

Next

The complete data has this structure:

{
    "data": [
          {
            "id": 18796712,
            "sport_id": 1,
            "league_id": 2451,
            "periods": [
                {
                    "id": 4646720,
                    "fixture_id": 18796712
                }
            ],
            "scores": [
                {
                    "id": 12200589,
                    "fixture_id": 18796712
                },
                {
                    "id": 12200590,
                    "fixture_id": 18796712
                },
                {
                    "id": 12200545,
                    "fixture_id": 18796712
                },
                {
                    "id": 12200546,
                    "fixture_id": 18796712,
                }
            ],
            "participants": [
                {
                    "id": 24401,
                    "sport_id": 1
                    }
                },
                {
                    "id": 11978,
                    "sport_id": 1
                    }
                }
            ],
            "ball_coordinates": [
                {
                    "id": 4549595,
                    "fixture_id": 18796712,
                    "period_id": 4646720,
                    "timer": "03:25",
                    "x": "39",
                    "y": "25"
                },
                {
                    "id": 4549532,
                    "fixture_id": 18796712,
                    "period_id": 4646720,
                    "timer": "03:20",
                    "x": "39",
                    "y": "25"
                },
                {
                    "id": 4549466,
                    "fixture_id": 18796712,
                    "period_id": 4646720,
                    "timer": "03:14",
                    "x": "39",
                    "y": "25"
                },
                {
                    "id": 4549422,
                    "fixture_id": 18796712,
                    "period_id": 4646720,
                    "timer": "03:11",
                    "x": "39",
                    "y": "25"
                }
            ]
        },
        {
            "id": 18560614,
            "sport_id": 1,
            "league_id": 603,
            "periods": [
                {
                    "id": 4646650,
                    "fixture_id": 18560614
                }
            ],
            "scores": [
                {
                    "id": 12200402,
                    "fixture_id": 18560614
                },
                {
                    "id": 12200392,
                    "fixture_id": 18560614
                },
                {
                    "id": 12200394,
                    "fixture_id": 18560614
                },
                {
                    "id": 12200401,
                    "fixture_id": 18560614
                }
            ],
            "participants": [
                {
                    "id": 4190,
                    "sport_id": 1
                },
                {
                    "id": 286,
                    "sport_id": 1
                    }
                }
            ],
            "ball_coordinates": [
                {
                    "id": 4549597,
                    "fixture_id": 18560614,
                    "period_id": 4646650,
                    "timer": "31:23",
                    "x": "0.42",
                    "y": "0.24"
                },
                {
                    "id": 4549579,
                    "fixture_id": 18560614,
                    "period_id": 4646650,
                    "timer": "31:20",
                    "x": "0.42",
                    "y": "0.24"
                },
                {
                    "id": 4549549,
                    "fixture_id": 18560614,
                    "period_id": 4646650,
                    "timer": "31:19",
                    "x": "0.61",
                    "y": "0.19"
                },
                {
                    "id": 4549483,
                    "fixture_id": 18560614,
                    "period_id": 4646650,
                    "timer": "31:14",
                    "x": "0.61",
                    "y": "0.19"
                },
                {
                    "id": 4549472,
                    "fixture_id": 18560614,
                    "period_id": 4646650,
                    "timer": "31:13",
                    "x": "0.41",
                    "y": "0.81"
                }
            ]
        }
    ]
}

Given the JSON you posted and using VBA-JSON, ball_coordinates would be a Collection object (which does have a Count property) containing one Scripting Dictionary object per contained item. The only way to get the max. value (or any other measure) across all of the "id" key values in those dictionaries is to loop over them. — Tim Williams
– Tim Williams, Commented Feb 28, 2023 at 22:17
If you were open to PowerQuery then you could get the Max of the Ids - if you tagged your question as such someone would probably be able to give you much shorter syntax too — Spectral Instance
– Spectral Instance, Commented Feb 28, 2023 at 22:34
@ Spectral instance Thank you for your help. The reason I look for a solution without looping is because of speed. I will make an API call every second in VBA and process the response every second within VBA. Do you expect PowerQuery to be faster for this purpose than a loop? I expect it will be pretty hard to implement for me since I do not have experience with PowerQuery, although I did some expirmenting with it before. — user2165379
– user2165379, Commented Mar 1, 2023 at 10:56

CDP1802 · Accepted Answer · 2023-03-04 13:34:12Z

0

Normally parsing json yourself with a regex is bad practice but for a simple case where speed is most important then it's an option. This should take ~0.2 seconds.

Sub MaxID()

    Dim fso, ts, regex, m1, m2, s As String, t0 As Single
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' load json from text file
    'Set ts = fso.OpenTextFile("30001.json")
    's = ts.ReadAll
    'ts.Close

    ' or load from api
    ' add http code here
    s = http.responseText
    t0 = Timer

    ' create regex
    Dim ar, i As Long
    Set regex = CreateObject("vbscript.regexp")
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        
        ' ball_coord tags
        .Pattern = "ball_coordinates\"": \[[^]]*]"
        If .test(s) Then
            Set m1 = .Execute(s)
        Else
            MsgBox "No ball_coordinates tags"
            Exit Sub
        End If
    
        ' id tags
        .Pattern = "\""id\"": *(\d+)" ' "id": 3938083,
    End With
    
    ' iterate matches
    Dim max As Long, id, n As Long
    For n = 1 To m1.Count
        Set m2 = regex.Execute(m1(n - 1))
        For i = 1 To m2.Count
            id = m2(i - 1).subMatches(0)
            'Debug.Print n, i, id
            If id > max Then max = id
        Next
    Next
    
    ' result
    MsgBox max, vbInformation, Format(Timer - t0, "0.0 secs")
      
End Sub

edited Mar 4, 2023 at 13:34

answered Mar 2, 2023 at 18:19

CDP1802

17.3k2 gold badges10 silver badges19 bronze badges

Sign up to request clarification or add additional context in comments.

14 Comments

user2165379 Over a year ago

Thanks a lot CDP1802! I currenly do not succeed to replace 30000.json with the correct object. I have tried http.responseText and json both with or without "". Excuse me if my question was not clear in mentioning I did receive the data from an API and that ball_coordinates is nested in a larger object json("data"). I have added Edit 3 with details.

CDP1802 Over a year ago

@user2165379 you can remove aĺl fso, ts code and use s=http.responseText

user2165379 Over a year ago

@ CDP1802 it runs without error although the identified maximum is from "fixture_id": instead of "id":. I suppose this is due to a nesting above where "id":. is also used for "fixture_id". I suppose this is very hard to solve. Alternatively I have tried to replace "id": with "timer\" in this way: "\""timer\"": *(\d+),". Although m.Count becomes 0 in this case. Maybe there is a problem that timer is a string? (That was the reason I choose to sort on id initially.)

CDP1802 Over a year ago

@user2165379 "\""id\"" shouldn't match fixture_id, I don't know why that is, it doesn't in my tests. m.Count is 0 because the capture pattern is wrong for the timer values. I guess there is more to the json file than the part you showed.

user2165379 Over a year ago

@ CDP1802 "id" does not match "fixture_id" although "id" is used for "fixture_id" in a nesting above. So "id" is matched with "id" in another part of the data. Excuse me I did not provide my complete code from the start. I will try to adapt the capture pattern for timer values.

|

user6585761 · Accepted Answer · 2023-03-02 02:46:37Z

0

Try something like this...

Dim json As Object
Set json = JsonConverter.ParseJson("{""ball_coordinates"":[ . . . ]}")

Dim ballCoordinatesCollection As Object
Set ballCoordinatesCollection = json("ball_coordinates")

Dim collectionItem As Object
Dim id As Long
Dim maxID As Long

maxID = 0
For Each collectionItem In ballCoordinatesCollection
    id = collectionItem("id")
    If id > maxID Then
        maxID = id
    End If
Next collectionItem

MsgBox "Maximum ID is " & maxID

answered Mar 2, 2023 at 2:46

user6585761

3 Comments

user2165379 Over a year ago

@ Domenic Thanks! Initially I received run-time error 10001: error parsing json. After deleting the dots . . . between [ ] the code runs without error. Although maxID is 0 since ballCoordinatesCollection is empty. (Object json is a Dictionary. Object ballCoordinatesCollection is a Collection.)

user6585761 Over a year ago

You'll need to pass JsonConverter.ParseJson() the actual json string.

user2165379 Over a year ago

It runs now. I used Set ballCoordinatesCollection = item("ball_coordinates"), since ball_coordinates is nested in data. data is from Set json = ParseJson(http.responseText). "For Each item In json("data")" is where item comes from. It runs in exactly the same time as my original code. I will try if I can modify it as in Edit 2 so that I can use WorksheetFunction.Max instead of If id > maxID.

Collectives™ on Stack Overflow

extract maximum of a json array in excel VBA without iterating

2 Answers 2

14 Comments

3 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

14 Comments

3 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related