Convert Excel Cells to JSON using VBA - json

Question

I am trying to convert Excel cells to JSON data but not able to implement correct logic.
Excel data is as follow
and excepted result is as follows
{
'pr1' : [ { 'hw' : ['LC', 'Repl']},
{ 'web' : ['LC', 'Repl']}
]
}
I have written below code but it is not working as expected.
For i = 1 To 546
If pro <> Cells(i, 1).Value Then
oFile.writeline ""
oFile.write '" + Cells(i, 1).Value + " ':{ '" + Cells(i, 2).Value + "' : ' " + Cells(i, 3).Value + "', "
Else
If pro = Cells(i, 1).Value Then
If opt1 <> Cells(i, 2).Value Then
oFile.writeline " , '" + Cells(i, 2).Value + "' : " + ",'" + Cells(i, 3).Value + "'"
Else
oFile.write '" + Cells(i, 3).Value + " ', "
oFile.write ""
End If
oFile.write " "
End If
oFile.write " "
End If
If pro = Cells(i + 1, 1).Value And opt1 <> Cells(i + 1, 2).Value Then
oFile.write " } "
End If
If pro <> Cells(i + 1, 1).Value And opt1 <> Cells(i + 1, 2).Value Then
oFile.write " "
End If
pro = Cells(i, 1).Value
opt1 = Cells(i, 2).Value
opt2 = Cells(i, 3).Value
Next i

Answer 1

use Dictionary object to store :
unique column A values as keys and a new dictionary as their item
for each key, the dictionary item will store column B values as unique keys and the combination of all column C values as their item
as follows:
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim key As Variant, key2 As Variant
Dim cel As Range
With Worksheets("MySheetName") ' change "MySheetName" to your actual sheet name
For Each cel In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants)
key = cel.Value: key2 = cel.Offset(, 1).Value
If Not dict.exists(key) Then dict.Add key, CreateObject("Scripting.Dictionary")
dict(key).Item(key2) = dict(key).Item(key2) & "'" & cel.Offset(, 2).Value & "',"
Next
End With
' build the JSON string for each key (i.e. only "pr1" in your example)
Dim s As String
For Each key In dict.keys
s = String(4, " ") & "{" & vbCrLf & String(4, " ") & "'" & key & "' : [ "
For Each key2 In dict(key)
s = s & "{ '" & key2 & "' : [" & Left(dict(key)(key2), Len(dict(key)(key2)) - 1) & "]}," & vbCrLf & String(12, " ")
Next
s = Left$(s, Len(s) - 15) & vbCrLf & String(4, " ") & "]" & vbCrLf & String(3, " ") & "}"
Debug.Print s
Next