# Faster output to Sheet from a collection of Dictionaries

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:

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

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.

• 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 – John Jul 2 at 9:45
• 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. – PeterT Jul 2 at 13:50
• @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 – John Jul 3 at 18:25

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


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
Dim r As Long, c As Long

r = 1
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

• 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) – John Jul 3 at 18:27
• @John your right I forgot to set c to the 2bd dimension. Did it improve the performance? How many worksheets are you updating? – TinMan Jul 4 at 0:02