Convert Excel Sheet (nested) to JSON - json

Question

I am giving a spreedsheet and I need to convert into JSON.
I have the following spreadsheet as so:
In essence, I'd need to convert into like this:
{ "CompanyA": {
"Products": ["Beds", "Knifes", "Spoons"]
}, "CompanyB": {
"Products": ["Beds", "Knifes", "Spoons"],
"Sites": ["West Coast", "East Coast"]
}, "CompanyC": {
"Office": ["Los Angeles"]
}}
I tried looking at online sources, but I haven't got a good solution to what I am looking for

Answer 1

Here's some basic code which should point you to the right direction.
I have commented it as much as possible.
Sub GetJSONOutput()
Dim wks As Worksheet: Set wks = ActiveSheet
Dim lngLastRow As Long, i As Long, j As Long, k As Long
Dim blFirstRow As Boolean
Dim strOut As String
lngLastRow = wks.Cells.Find("*", wks.Cells(1, 1), , , , xlPrevious).Row
k = 1
For i = 1 To lngLastRow
'\\ First Element - Column A
'\\ Check for first line and build beginning style
If Len(wks.Cells(i, 1).Value) > 0 Then
If blFirstRow = False Then
strOut = "{ """ & wks.Cells(i, 1).Value & """: {"
blFirstRow = True
Else '\\ Rest follow the same style
strOut = "}, """ & wks.Cells(i, 1).Value & """: {"
End If
wks.Cells(k, 4).Value = strOut: k = k + 1 '--> Output Column D
End If
'\\ Middle element - Column B
If Len(wks.Cells(i, 2).Value) > 0 Then strbase = " """ & wks.Cells(i, 2).Value & """: ["
If Len(wks.Cells(i, 3).Value) > 0 Then
'\\ Now we have Middle element then we need to loop through all elements under it!
'\\ Last Element - Column C
If Len(wks.Cells(i + 1, 3).Value) > 0 Then
strAppend = ""
For j = i To wks.Cells(i, 3).End(xlDown).Row
strAppend = strAppend & "|" & wks.Cells(j, 3).Value
Next j
strOut = strbase & """" & Replace(Mid(strAppend, 2, Len(strAppend)), "|", Chr(34) & ", " & Chr(34)) & """]"
wks.Cells(k, 4).Value = strOut: k = k + 1 '--> Output Column D
i = j - 1
Else
strOut = strbase & """" & wks.Cells(i, 3).Value & """]"
wks.Cells(k, 4).Value = strOut: k = k + 1 '--> Output Column D
End If
End If
'\\ Complete output by outputting the last closing brackets
If i = lngLastRow Then
strOut = "}}"
wks.Cells(k, 4).Value = strOut '--> Output Column D
End If
Next i
End Sub

Answer 2

Sub ConvertToJSONText()
Dim Sht As Worksheet
Set Sht = Worksheets("Sheet1")
Dim a As Integer
Dim lstA
Dim lstB
Dim lstC
a = 0
Dim myJsonText
myJsonText = "{"
Do While True
a = a + 1
If Sht.Range("a" & a).Value = "" And Sht.Range("b" & a).Value = "" And Sht.Range("c" & a).Value = "" Then
Exit Do
End If
If Sht.Range("a" & a).Value <> "" And Sht.Range("b" & a).Value = "" And Sht.Range("c" & a).Value = "" Then
If lstB <> "" Then myJsonText = myJsonText & "]"
If lstA <> "" Then myJsonText = myJsonText & "},"
lstA = Sht.Range("a" & a).Value
lstB = ""
lstC = ""
myJsonText = myJsonText & """" & lstA & """: {"
End If
If Sht.Range("a" & a).Value = "" And Sht.Range("b" & a).Value <> "" And Sht.Range("c" & a).Value = "" Then
If lstB <> "" Then myJsonText = myJsonText & "]"
lstB = Sht.Range("B" & a).Value
lstC = ""
myJsonText = myJsonText & """" & lstB & """: ["
End If
If Sht.Range("a" & a).Value = "" And Sht.Range("b" & a).Value = "" And Sht.Range("c" & a).Value <> "" Then
If lstC <> "" Then myJsonText = myJsonText & ","
lstC = Sht.Range("C" & a).Value
myJsonText = myJsonText & """" & lstC & """"
End If
Loop
If lstB <> "" Then myJsonText = myJsonText & "]"
myJsonText = myJsonText & "}"
End Sub