expected_result.png

Trying to accomplish this output but have no luck. If anyone can help it will be very much appreciated.


current code

Option Explicit

Private Sub CommandButtonJSON_Click()

Dim cLetter As String, lRow As Long

lRow = Range("A" & Rows.Count).End(xlUp).Row
cLetter = Split(ActiveSheet.Cells.Find(What:="*", After:=[A5], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Cells.Address(1, 0), "$")(0)

Dim data() As Variant
data = Range("A5:" & cLetter & lRow).Value

Dim RootTree As Object
Set RootTree = CreateObject("Scripting.Dictionary")

Dim iRow As Long
For iRow = LBound(data, 1) To UBound(data, 1)
Dim Parent As Object
Set Parent = RootTree

Dim iCol As Long
For iCol = LBound(data, 2) To UBound(data, 2)

If data(iRow, iCol) <> "" Then

If Not Parent.Exists(data(iRow, iCol)) Then

Parent.Add data(iRow, iCol), CreateObject("Scripting.Dictionary")

End If

Set Parent = Parent(data(iRow, iCol))

End If

Next iCol

Next iRow

ThisWorkbook.Worksheets("JSON").Range("B2").Value = vbNewLine & JsonConverter.ConvertToJson(RootTree, Whitespace:=3)

End Sub