How to fix "Subscript out of range" error in XML HTTP Request

Question

I have a code that works fine but triggers an error "Subscript out of range" at the commented line in the code below.

I have used a json formatter online to view the XML structure and I don't seem to see the reason why the error is triggered. For now, if I comment out those last two nodes, the code works fine. The code I'm using can be referenced here - Extracting HTML elements values using their classes

With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://www.betfair.com/www/sports/exchange/readonly/v1/bymarket?_ak=nzIFcwyWhrlwYMrh&alt=json&currencyCode=USD&locale=en&marketIds=1.161189078,1.161073119,1.161362337,1.161362195,1.161362198,1.161362200,1.161362186,1.161362202,1.161362187,1.161362205,1.161362188,1.161362189,1.161425408&rollupLimit=25&rollupModel=STAKE&types=MARKET_STATE,%20EVENT,RUNNER_DESCRIPTION,RUNNER_STATE,RUNNER_EXCHANGE_PRICES_BEST", False
    .send
    s = .responseText
    Set json = JsonConverter.ParseJson(s)
End With

Dim runners As Object, runner As Object, results(), r As Variant
Set runners = json("eventTypes")(1)("eventNodes")

ReDim results(1 To runners.Count, 1 To 7)
For Each runner In runners
    r = r + 1
    results(r, 1) = runner("event")("eventName")
    results(r, 2) = runner("marketNodes")(1)("runners")(1)("exchange")("availableToBack")(1)("price")
    results(r, 3) = runner("marketNodes")(1)("runners")(1)("exchange")("availableToLay")(1)("price")
    results(r, 4) = runner("marketNodes")(1)("runners")(2)("exchange")("availableToBack")(1)("price")
    results(r, 5) = runner("marketNodes")(1)("runners")(2)("exchange")("availableToLay")(1)("price")
    ''results(r, 6) = runner("marketNodes")(1)("runners")(3)("exchange")("availableToBack")(1)("price")
    ''results(r, 7) = runner("marketNodes")(1)("runners")(3)("exchange")("availableToLay")(1)("price")
Next

I need help in fixing that error and making all the nodes work.

What is `runners.Count` value? You might be running outside the range of `results` with your incrementing of `r`. — Dean, Aug 17 '19 at 09:58
@SmithO. Check further down the line. What's the count of `runner("marketNodes")`, `runner("marketNodes")(1)` etc. — GSerg, Aug 17 '19 at 10:12

Luuk · Answer 1 · 2019-08-17T13:40:04.093

You should check if a node exists, looking at the (converted) XML you can see that availableToBack and availabletoLay do not always exist.

There's only 1 availableToLay under "Kent v Essex", and t availableToBack:

<eventNodes>
  <eventId>29417978</eventId>
  <event>
    <eventName>Kent v Essex</eventName>
    <countryCode>GB</countryCode>
    <timezone>GMT</timezone>
    <openDate>2019-08-18T10:00:00Z</openDate>
  </event>
  <marketNodes>
    <marketId>1.161362186</marketId>
    <isMarketDataDelayed>true</isMarketDataDelayed>
    <state>
      <betDelay>0</betDelay>
      <bspReconciled>false</bspReconciled>
      <complete>true</complete>
      <inplay>false</inplay>
      <numberOfWinners>1</numberOfWinners>
      <numberOfRunners>3</numberOfRunners>
      <numberOfActiveRunners>3</numberOfActiveRunners>
      <totalMatched>0</totalMatched>
      <totalAvailable>14844.762771507034</totalAvailable>
      <crossMatching>true</crossMatching>
      <runnersVoidable>false</runnersVoidable>
      <version>2893531625</version>
      <status>OPEN</status>
    </state>
    <runners>
      <selectionId>5901</selectionId>
      <handicap>0</handicap>
      <description>
        <runnerName>Kent</runnerName>
      </description>
      <state>
        <sortPriority>1</sortPriority>
        <totalMatched>0</totalMatched>
        <status>ACTIVE</status>
      </state>
      <exchange>
        <availableToBack>
          <price>1.42</price>
          <size>56.84</size>
        </availableToBack>
        <availableToBack>
          <price>1.1</price>
          <size>13.6</size>
        </availableToBack>
        <availableToLay>
          <price>100</price>
          <size>8.51</size>
        </availableToLay>
      </exchange>
    </runners>

This can be done like this: (please note, I do not do this kind of stuff in Excel very often, so there might be 'smarter' way to do this ... )

With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://www.betfair.com/www/sports/exchange/readonly/v1/bymarket?_ak=nzIFcwyWhrlwYMrh&alt=json&currencyCode=USD&locale=en&marketIds=1.161189078,1.161073119,1.161362337,1.161362195,1.161362198,1.161362200,1.161362186,1.161362202,1.161362187,1.161362205,1.161362188,1.161362189,1.161425408&rollupLimit=25&rollupModel=STAKE&types=MARKET_STATE,%20EVENT,RUNNER_DESCRIPTION,RUNNER_STATE,RUNNER_EXCHANGE_PRICES_BEST", False
    .send
    s = .responseText
    Set json = JsonConverter.ParseJson(s)
End With

Dim runners As Object, runner As Object, results(), r As Variant
Set runners = json("eventTypes")(1)("eventNodes")
Dim obj0 As Object

ReDim results(1 To runners.Count, 1 To 7)
intEventNode = 1
For Each eventNode In runners
    r = r + 1

    Name = eventNode("event")("eventName")
    If eventNode.Exists("marketNodes") Then
        intMarketNode = 1
        For Each marketNode In json("eventTypes")(1)("eventNodes")(intEventNode)("marketNodes")
            If marketNode.Exists("runners") Then
                intRunner = 1
                For Each runner In json("eventTypes")(1)("eventNodes")(intEventNode)("marketNodes")(intMarketNode)("runners")
                    If runner.Exists("exchange") Then
                        runnerName = runner("description")("runnerName")
                        For Each ex In json("eventTypes")(1)("eventNodes")(intEventNode)("marketNodes")(intMarketNode)("runners")(intRunner)("exchange")("availableToBack")
                            If ex.Exists("price") Then
                                    'MsgBox "name: " + Name + Chr$(13) + "runnerName: " + runnerName + Chr$(13) + "availableToBack: " + CStr(ex("price"))
                                    Cells(r, 1) = Name
                                    Cells(r, 2) = runnerName
                                    Cells(r, 3) = "availableToBack"
                                    Cells(r, 4) = ex("price")
                                    Cells(r, 5) = ex("size")
                                    r = r + 1
                            End If
                        Next
                        For Each ex In json("eventTypes")(1)("eventNodes")(intEventNode)("marketNodes")(intMarketNode)("runners")(intRunner)("exchange")("availableToLay")
                            If ex.Exists("price") Then
                                    'MsgBox "name: " + Name + Chr$(13) + "runnerName: " + runnerName + Chr$(13) + "availableToLay: " + CStr(ex("price"))
                                    Cells(r, 1) = Name
                                    Cells(r, 2) = runnerName
                                    Cells(r, 3) = "availableToLay"
                                    Cells(r, 4) = ex("price")
                                    Cells(r, 5) = ex("size")
                                    r = r + 1

                            End If
                        Next
                    End If
                    intRunner = intRunner + 1
                Next
            End If
            intMarketNode = intMarketNode + 1
        Next
        intEventNode = intEventNode + 1
    End If
Next

Please how do I check if a node exist – Smith O. Aug 17 '19 at 11:23 — Smith O., Aug 17 '19 at 11:23

QHarr · Accepted Answer · 2019-08-17T13:30:44.163

Your error is coming from attempting to access an index that is out of bounds (too high) in runners collection. When you get to index 11 (0 based - or 12 when 1 based as per VBA JSON Collection) there are only two items, not 3, in runners collection. I usually handle this with an On Error Resume Next On Error GoTo 0 wrapper around the lines which populate the array - this leaves blanks for missing items. By far my preference when you know the dimensions of the array you want to populate and only need to handle some items not being present.

VBA:

Option Explicit

Public Sub WriteOutResults()
    Dim s As String, json As Object

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.betfair.com/www/sports/exchange/readonly/v1/bymarket?_ak=nzIFcwyWhrlwYMrh&alt=json&currencyCode=USD&locale=en&marketIds=1.161189078,1.161073119,1.161362337,1.161362195,1.161362198,1.161362200,1.161362186,1.161362202,1.161362187,1.161362205,1.161362188,1.161362189,1.161425408&rollupLimit=25&rollupModel=STAKE&types=MARKET_STATE,%20EVENT,RUNNER_DESCRIPTION,RUNNER_STATE,RUNNER_EXCHANGE_PRICES_BEST", False
        .send
        s = .responseText
        Set json = JsonConverter.ParseJson(s)
    End With

    Dim runners As Object, runner As Object, results(), r As Variant
    Set runners = json("eventTypes")(1)("eventNodes")

    ReDim results(1 To runners.Count, 1 To 7)
    For Each runner In runners
        r = r + 1
        On Error Resume Next
        results(r, 1) = runner("event")("eventName")
        results(r, 2) = runner("marketNodes")(1)("runners")(1)("exchange")("availableToBack")(1)("price")
        results(r, 3) = runner("marketNodes")(1)("runners")(1)("exchange")("availableToLay")(1)("price")
        results(r, 4) = runner("marketNodes")(1)("runners")(2)("exchange")("availableToBack")(1)("price")
        results(r, 5) = runner("marketNodes")(1)("runners")(2)("exchange")("availableToLay")(1)("price")
        results(r, 6) = runner("marketNodes")(1)("runners")(3)("exchange")("availableToBack")(1)("price")
        results(r, 7) = runner("marketNodes")(1)("runners")(3)("exchange")("availableToLay")(1)("price")
        On Error GoTo 0
    Next
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub

Just what I needed. QHarr, Thanks a bunch! – Smith O. Aug 17 '19 at 13:29 — Smith O., Aug 17 '19 at 13:29

How to fix "Subscript out of range" error in XML HTTP Request

2 Answers2