2
\$\begingroup\$

My code is currently offloading parsed data into multiple spreadsheets, but it's pretty slow: about 110k rows and 35 columns in 3.5 minutes. I was wondering if there were a more efficient way of looping through my collection of dictionaries.

Sub getData(Parsed As Object, company As String, a, wb)
        'Parsed contains a collection of dictionaries parsed from a JSON input'

        Dim oSheet As Variant
        Dim i As Long
        Dim j As Long
        For Each oSheet In ActiveWorkbook.Sheets
            'Identify the sheet containing the name of the company'
            Dim matchSheet As String
            If InStr(UCase(oSheet.Name), UCase(company)) Then
                matchSheet = oSheet.Name
            Else
                GoTo nextIteration
            End If
                'Create a 2d array of i number of dictionaries and j number of element in each dictionary'
                Dim Values As Variant
                ReDim Values(Parsed.Count, ArrayLen(a))

                Dim Value As Dictionary
                Dim key As Variant

                i = 1
                j = 0
                wb.Sheets(matchSheet).Select 'macro not working without selecting the sheet'
                wb.Sheets(matchSheet).Cells.Clear 'Clearing the data in the company Sheet'

                'For loops populating the Values array'
                For Each Value In Parsed
                    For Each key In a
                        Values(i, j) = Value(key)
                        j = j + 1
                    Next key
                    j = 0
                  i = i + 1
                Next Value

                'populating the needed sheet range with the parsed data'
                wb.Sheets(matchSheet).Range(Cells(1, 1), Cells(Parsed.Count, ArrayLen(a))) = Values
                'populationg the headers for that data'
                wb.Sheets(matchSheet).Range(Cells(1, 1), Cells(1, ArrayLen(a))).Value = a
                wb.Sheets(matchSheet).Range("D:D").NumberFormat = "General"
nextIteration:
        Next oSheet

End Sub

Here is an exemple of what my API request returning 2 deals with 3 keys out of 37:

[
   {
      "DealNo": "11111",
      "DealDate": "2010-01-01",
      "Quantity": "1000"
   },
   {
      "DealNo": "11112",
      "DealDate": "2010-01-02",
      "Quantity": "2000"
   }
]

And here is the structure of the data after it has been parsed in excel: Collection

\$\endgroup\$
  • \$\begingroup\$ Do you have a (much smaller) example of your JSON for testing? \$\endgroup\$ – PeterT Jul 1 at 20:07
  • 1
    \$\begingroup\$ I don't understand what a is. \$\endgroup\$ – AJD Jul 1 at 21:58
2
\$\begingroup\$

A couple of review points.

Goto. Using Goto is a real bad smell. In your case, you can remove the spaghetti very easily.

Sub getData(Parsed As Object, company As String, a, wb)
        'Parsed contains a collection of dictionaries parsed from a JSON input'
        Dim oSheet As Variant
        Dim i As Long
        Dim j As Long
        For Each oSheet In ActiveWorkbook.Sheets
            'Identify the sheet containing the name of the company'
            Dim matchSheet As String
            If InStr(UCase(oSheet.Name), UCase(company)) Then
                matchSheet = oSheet.Name
            Else
                GoTo nextIteration
            End If
                ' [Main Code Block]
nextIteration:
        Next oSheet
End Sub

Becomes

Sub getData(Parsed As Object, company As String, a, wb)
        'Parsed contains a collection of dictionaries parsed from a JSON input'
        Dim oSheet As Variant
        Dim i As Long
        Dim j As Long
        For Each oSheet In ActiveWorkbook.Sheets
            'Identify the sheet containing the name of the company'
            Dim matchSheet As String
            If InStr(UCase(oSheet.Name), UCase(company)) Then
                matchSheet = oSheet.Name
                ' [Main Code Block]
            End If
        Next oSheet
End Sub

Much cleaner!

Select. I can see why your code does not work without using Select. And you do not need it. You have unqualified references to Range objects (in this case Cells) that are acting on the active sheet. By selecting the sheet, you are changing the active sheet but there is no guarantee that it is going to stay that way!

            wb.Sheets(matchSheet).Range(Cells(1, 1), Cells(Parsed.Count, ArrayLen(a))) = Values
            'populationg the headers for that data'
            wb.Sheets(matchSheet).Range(Cells(1, 1), Cells(1, ArrayLen(a))).Value = a
            wb.Sheets(matchSheet).Range("D:D").NumberFormat = "General"

Is better expressed in a With statement for brevity and ease of reading (note that the "." are also in front of the Cells, this is the critical change to your original code).

            With wb.Sheets(matchSheet)
                .Range(.Cells(1, 1), .Cells(Parsed.Count, ArrayLen(a))) = Values
                'populating the headers for that data'
                .Range(.Cells(1, 1), .Cells(1, ArrayLen(a))).Value = a
                .Range("D:D").NumberFormat = "General"
            End With

ReDim. Probably not a huge issue, but you ReDim every loop instance on values that are passed in at the start. Set your Values array up once before you enter the loop. By the looks of your code, you clobber the values in the array each time you go through the loop, so you don't even have to clear it.

I would guess that your biggest performance hit is iterating through the dictionaries. If you could bring your data in in a cleaner fashion, it may help your performance.

\$\endgroup\$
  • \$\begingroup\$ Thank you for the feedback. I realize now that the goto was completely useless in that case. Iterating through a collection of dictionaries is definitely hitting my performance especially as I was offloading the data cell by cell at first (which took an eternity). How would you suggest importing the data in a cleaner fashion? Currently, I just use Tim Hall's JSON parser link to get my Parsed variable \$\endgroup\$ – John Jul 2 at 9:45
  • \$\begingroup\$ It's entirely possible that you don't have to create an array of dictionaries because that structure already exists in the Parsed object, as returned by the JSON parser. Without seeing a JSON example of the structure, you can evaluate each section as shown in this answer to see if that helps. \$\endgroup\$ – PeterT Jul 2 at 13:50
  • \$\begingroup\$ @PeterT I took a look at your link and if i understood correctly anytime you see the square brackets [] JSONConverter maps it to collection and maps {} to a dictionary. It seems that this is exactly what happens in my case. Is there therefore no other way to load the data on the spreadsheet faster? I added JSON example and the returned structure in excel \$\endgroup\$ – John Jul 3 at 18:25
0
\$\begingroup\$

Here's a very quick example of how you can simply assign a Collection and Dictionary directly from the parsed JSON object directly into your objects, then convert it into a 2-D array.

Option Explicit

Public Sub test()
    Dim jsonInput As String
    jsonInput = "{ ""dataset"":[ { ""DealNo"":""11111"", ""DealDate"":""2010-01-01"", ""Quantity"":""1000"" }, { ""DealNo"":""11112"", ""DealDate"":""2010-01-02"", ""Quantity"":""2000"" } ]}"

    Dim json As Object
    Set json = ParseJson(jsonInput)

    DataToRange json
End Sub


Private Sub DataToRange(ByRef parsed As Object)
    '--- extract the array of data from the JSON input
    Dim dataset As Collection
    Set dataset = parsed("dataset")

    '--- now grab the first entry in the data set as assume all
    '    entries have the same number of fields
    Dim deal As Dictionary
    Set deal = dataset(1)

    '--- create an array to hold the converted data
    Dim dealData As Variant
    ReDim dealData(1 To dataset.Count, 0 To deal.Count - 1)

    '--- now convert the data set into an array
    Dim i As Long
    Dim j As Long
    For i = 1 To dataset.Count
        Set deal = dataset(i)
        For j = 0 To deal.Count - 1
            dealData(i, j) = deal.Items(j)
        Next j
    Next i

    '--- now set up the destination range and copy the deal data
    '    to that range
    Dim dealArea As Range
    Set dealArea = Sheet1.Range("A1").Resize(UBound(dealData, 1), UBound(dealData, 2))
    dealArea.Value = dealData
End Sub
\$\endgroup\$
0
\$\begingroup\$

As AJD stated there is no need to recreate the array of values for each sheet.

I don't like Sub getData() because Get implies that a value is going to be returned. Sub setData() isn't appropriate either because Set implies that a value is being set. UpdateData() makes sense but not in a Public Module. Using undescriptive names in Public Modules can lead to confusion down the road as a project grows. Using a name like Sub UpdateCompanyJSONInformation() will make it clear exactly what the macro is meant to do.

ArrayLen() is used in the code but never declared. I imagine that it returns Ubound(Array) + Lbound(Array). I personally would throw ArrayLen() into the trash with GetColumnLetter() and similar helper functions that are floating around the internet. IMO ArrayLen() is obfuscating the code by masking a simple coding pattern that we should easily recognize.

i = 1: j = 0 This was a little confusing for me. At first it looked like the i dimension was 1 based and the j dimension was 0 based. Not knowing exactly what ArrayLen() returned added to the confusion. I had to look over the way the values were being written to the worksheet several times before I realized the the first row was empty. You should fit the Array to your data. I can guarantee that if you come back to this project in 1 to 2 years to make a simple modification, you will not remember that you the first row of data is empty.

Refactored Code

Sub UpdateCompanyJSONInformation(Parsed As Object, company As String, headers As Variant, wb)
    Application.ScreenUpdating = False
'Parsed contains a collection of dictionaries parsed from a JSON input'

    Dim oSheet As Variant, Values As Variant
    For Each oSheet In ActiveWorkbook.Sheets
        With oSheet
            'Identify the sheet containing the name of the company'

            If InStr(1, oSheet.Name, company, vbTextCompare) Then
                If Not IsArray(Values) Then Values = getCompanyJSONInformation(Parsed, headers)

                .Cells.Clear 'Clearing the data in the company Sheet'
                .Range("A1").Resize(UBound(Values), UBound(Values, 2)).Value = Values
            End If
        End With
    Next oSheet

End Sub

Function getCompanyJSONInformation(Parsed As Object, headers As Variant) As Variant
    Dim key As Variant, Values As Variant
    Dim Value As Dictionary
    ReDim Values(1 To Parsed.Count + 1, LBound(headers) + 1 To UBound(headers) + 1 - LBound(headers))
    Dim r As Long, c As Long

    r = 1
    For Each key In headers
        c = c + 1
        Values(r, c) = key
    Next

    For Each Value In Parsed
        r = r + 1
        For c = 1 To UBound(Values, 2)
            key = Values(1, c)
            Values(r, c) = Value(key)
        Next
    Next
    getCompanyJSONInformation = Values
End Function
\$\endgroup\$
  • \$\begingroup\$ Great! I implemented it and it works nice! just had to specify on which dimension I want the For c = 1 To Ubound(Values) to be applied, in my case For c = 1 To Ubound(Values, 2) \$\endgroup\$ – John Jul 3 at 18:27
  • \$\begingroup\$ @John your right I forgot to set c to the 2bd dimension. Did it improve the performance? How many worksheets are you updating? \$\endgroup\$ – TinMan Jul 4 at 0:02

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.