Converted the JSON Parsing Code to Arrays and getting error-CodePudding

I was working on a project to extract the data from API and Parsing it through the relevant column. The first one is working very fine but its optimizing speed is extremely slow.

so i though to convert it into arrays for fast processing but geeting Run-time error 9 Subscript out of range`

Your help will be much appreciated to fix the issue.

First code with slow optimization.

Dim json As Object
Dim timeEntry As Object
Dim ti As Object
Dim lastRow As Long
Dim myValue As String

Set json = JsonConverter.ParseJson(Data)
i = 2
lastRow = Sheet2.Range("A1").End(xlUp).Row

For Each timeEntry In json("timeentries")
    With Sheet2.Cells(i, 1)
        .Value = timeEntry("projectName")
        .Offset(0, 4).Value = timeEntry("taskName")
        .Offset(0, 8).Value = timeEntry("description")
        .Offset(0, 9).Value = timeEntry("clientName")
    End With

    Set ti = timeEntry("timeInterval")
    With Sheet2.Cells(i, 1)
        .Offset(0, 10).Value = ti("start")
        .Offset(0, 6).Value = ti("duration")
    End With
    i = i   1
Next timeEntry

Second code with Arrays and getting error

Dim json As Object
Dim timeEntry As Object
Dim ti As Object
Dim lastRow As Long
Dim myValue As String

Set json = JsonConverter.ParseJson(Data)
i = 2
lastRow = Sheet2.Range("A1").End(xlUp).Row

Dim dataArray() As Variant
ReDim dataArray(1 To lastRow, 1 To 12)

For Each timeEntry In json("timeentries")
    dataArray(i, 1) = timeEntry("projectName")
    dataArray(i, 5) = timeEntry("taskName")
    dataArray(i, 9) = timeEntry("description")
    dataArray(i, 10) = timeEntry("clientName")

    Set ti = timeEntry("timeInterval")
    dataArray(i, 11) = ti("start")
    dataArray(i, 7) = ti("duration")
    i = i   1
Next timeEntry

Sheet2.Range("A2").Resize(lastRow, 12).Value = dataArray

CodePudding user response：

Size array to number of entries

Sub demo()

    Dim json As Object, t As Object
    Dim data, i As Long, n As Long
    data = "{'timeentries':[" & _
           "{'projectName':'Name1','taskName':'Task1','timeInterval':{'start':'08:00','duration':'123'}}," & _
           "{'projectName':'Name2','taskName':'Task2','timeInterval':{'start':'09:00','duration':'234'}}," & _
           "{'projectName':'Name3','taskName':null,'timeInterval':{'start':'10:00','duration':'345'}}]}"
    
    Set json = JsonConverter.ParseJson(data)
    n = json("timeentries").Count
    If n < 1 Then
        MsgBox "No timeentries in JSON", vbCritical
        Exit Sub
    End If
  
    Dim dataArray() As Variant
    ReDim dataArray(1 To n, 1 To 6)
    
    i = 1
    For Each t In json("timeentries")
        dataArray(i, 1) = t("projectName") '1
        If Not IsNull(t("taskName")) Then
            dataArray(i, 2) = t("taskName") '5
        End If
        dataArray(i, 3) = t("description") '9
        dataArray(i, 4) = t("clientName") '10
        dataArray(i, 5) = t("timeInterval")("start") '11
        dataArray(i, 6) = t("timeInterval")("duration") '77
        i = i   1
    Next
    
    ' columns
    Dim col: col = Array(1, 5, 9, 10, 11, 7)
    For i = 0 To UBound(col)
        Sheet2.Cells(2, col(i)).Resize(n) = WorksheetFunction.Index(dataArray, 0, i   1)
    Next

End Sub