user14286902
Reputation:
Trying to Convert Excel Format into JSON
I am trying to convert the excel data into below JSON format but my code is not converting this is in accurate format. You help will be much appreciated.
There is extra [ in the format how to achieve this with Excel VBA.
The Excel Data
Required JSON Format
My code
Public Function ToJSON(rng As Range) As String
' Make sure there are two columns in the range
If rng.Columns.Count < 2 Then
ToJSON = CVErr(xlErrNA)
Exit Function
End If
Dim dataLoop, headerLoop As Long
' Get the first row of the range as a header range
Dim headerRange As Range: Set headerRange = Range(rng.Rows(1).Address)
' We need to know how many columns are there
Dim colCount As Long: colCount = headerRange.Columns.Count
Dim json As String: json = "["
For dataLoop = 1 To rng.Rows.Count
' Skip the first row as it's been used as a header
If dataLoop > 1 Then
' Start data row
Dim rowJson As String: rowJson = "{"
' Loop through each column and combine with the header
For headerLoop = 1 To colCount
rowJson = rowJson & """" & headerRange.Value2(1, headerLoop) & """" & ":"
rowJson = rowJson & """" & rng.Value2(dataLoop, headerLoop) & """"
rowJson = rowJson & ","
Next headerLoop
' Strip out the last comma
rowJson = Left(rowJson, Len(rowJson) - 1)
' End data row
json = json & rowJson & "},"
End If
Next
' Strip out the last comma
json = Left(json, Len(json) - 1)
json = json & "]"
ToJSON = json
End Function
Upvotes: 2
Views: 699
Answers (3)
Raymond Wu
Reputation: 3387
Since you only provided data for the 1st set of JSON format (the 2nd set of format looks weird anyway, are you sure that's correct?), below code only cater for the 1st set of JSON format:
Public Function ToJSON(rng As Range) As String
' Make sure there are two columns in the range
If rng.Columns.Count < 2 Then
ToJSON = CVErr(xlErrNA)
Exit Function
End If
Const rootKey As String = "sections"
Const surveyKey As String = "surveyQuestions"
Dim rngArr As Variant
rngArr = rng.Value2
Dim JSONStr As String
Dim JSONSurvey As String
Dim i As Long
' Skip the first row as it's been used as a header
For i = 2 To UBound(rngArr, 1)
If rngArr(i, 1) <> vbNullString Or rngArr(i, 2) <> vbNullString Then
If rngArr(i, 1) <> vbNullString Then
Dim currentName As String
If rngArr(i, 1) <> currentName Then
If currentName <> vbNullString Then
currentName = rngArr(i, 1)
JSONStr = JSONStr & JSONSurvey & "]},{" & KeyValue(rngArr(1, 1), rngArr(i, 1)) & "," & Chr(34) & surveyKey & Chr(34) & ": ["
JSONSurvey = vbNullString
Else
currentName = rngArr(i, 1)
JSONStr = JSONStr & "{" & KeyValue(rngArr(1, 1), rngArr(i, 1)) & "," & Chr(34) & surveyKey & Chr(34) & ": ["
End If
Else
End If
Else
JSONSurvey = JSONSurvey & ","
End If
Dim n As Long
For n = 2 To UBound(rngArr, 2)
If n = 2 Then JSONSurvey = JSONSurvey & "{"
Select Case n
Case 4, 5: JSONSurvey = JSONSurvey & KeyValue(rngArr(1, n), rngArr(i, n), False)
Case Else: JSONSurvey = JSONSurvey & KeyValue(rngArr(1, n), rngArr(i, n))
End Select
If n <> UBound(rngArr, 2) Then
JSONSurvey = JSONSurvey & ","
Else
JSONSurvey = JSONSurvey & "}"
End If
Next n
End If
Next
JSONStr = JSONStr & JSONSurvey & "]}"
' Strip out the last comma
JSONStr = Left(JSONStr, Len(JSONStr) - 1)
ToJSON = "{" & Chr(34) & rootKey & Chr(34) & ": [" & _
JSONStr & _
"}]}"
End Function
Private Function KeyValue(argKey As Variant, argValue As Variant, Optional ValueAsText As Boolean = True) As String
If ValueAsText Then
KeyValue = Chr(34) & argKey & Chr(34) & ":" & Chr(34) & argValue & Chr(34)
Else
KeyValue = Chr(34) & argKey & Chr(34) & ":" & LCase(argValue)
End If
End Function
Running this to Range("A1:G23") which is your entire data will produce this:
{"sections": [{"name":"About the inspection","surveyQuestions": [{"questionText":"report name","questionHelp":"some help 1","sortOrder":1,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"surveyor","questionHelp":"some help 2","sortOrder":2,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"asssigned to","questionHelp":"some help 3","sortOrder":3,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"client firstname","questionHelp":"some help 4","sortOrder":4,"isActive":true,"questionType":"NUMBER","options":""},{"questionText":"client lastname","questionHelp":"some help 5","sortOrder":5,"isActive":true,"questionType":"STARS","options":""},{"questionText":"report reference","questionHelp":"some help 6","sortOrder":6,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"date of inspection","questionHelp":"some help 7","sortOrder":7,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"house / building number","questionHelp":"some help 8","sortOrder":8,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"address line 1","questionHelp":"some help 9","sortOrder":9,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"address line 2","questionHelp":"some help 10","sortOrder":10,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"postcode","questionHelp":"some help 11","sortOrder":11,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"weather conditions","questionHelp":"some help 12","sortOrder":12,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"property status","questionHelp":"some help 13","sortOrder":13,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"property type","questionHelp":"property help","sortOrder":14,"isActive":true,"questionType":"LIST","options":"Bungalow;Semi-detatched, Detached, Terraced, Flat"}]},{"name":"Overall opinion","surveyQuestions": [{"questionText":"our overall opinion of the property","questionHelp":"some help 15","sortOrder":1,"isActive":true,"questionType":"TEXT","options":""}]},{"name":"About the property","surveyQuestions": [{"questionText":"type of property","questionHelp":"some help 17","sortOrder":1,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"approximate year property was built","questionHelp":"some help 18","sortOrder":2,"isActive":true,"questionType":"NUMBER","options":""},{"questionText":"approximate year the property was extended","questionHelp":"some help 19","sortOrder":3,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"approximate year the property was converted","questionHelp":"some help 20","sortOrder":4,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"information relevant to flats and maisonettes","questionHelp":"some help 21","sortOrder":5,"isActive":true,"questionType":"TEXT","options":""}]}]}
And the pretty print version:
{
"sections": [
{
"name": "About the inspection",
"surveyQuestions": [
{
"questionText": "report name",
"questionHelp": "some help 1",
"sortOrder": 1,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "surveyor",
"questionHelp": "some help 2",
"sortOrder": 2,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "asssigned to",
"questionHelp": "some help 3",
"sortOrder": 3,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "client firstname",
"questionHelp": "some help 4",
"sortOrder": 4,
"isActive": true,
"questionType": "NUMBER",
"options": ""
},
{
"questionText": "client lastname",
"questionHelp": "some help 5",
"sortOrder": 5,
"isActive": true,
"questionType": "STARS",
"options": ""
},
{
"questionText": "report reference",
"questionHelp": "some help 6",
"sortOrder": 6,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "date of inspection",
"questionHelp": "some help 7",
"sortOrder": 7,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "house / building number",
"questionHelp": "some help 8",
"sortOrder": 8,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "address line 1",
"questionHelp": "some help 9",
"sortOrder": 9,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "address line 2",
"questionHelp": "some help 10",
"sortOrder": 10,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "postcode",
"questionHelp": "some help 11",
"sortOrder": 11,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "weather conditions",
"questionHelp": "some help 12",
"sortOrder": 12,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "property status",
"questionHelp": "some help 13",
"sortOrder": 13,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "property type",
"questionHelp": "property help",
"sortOrder": 14,
"isActive": true,
"questionType": "LIST",
"options": "Bungalow;Semi-detatched, Detached, Terraced, Flat"
}
]
},
{
"name": "Overall opinion",
"surveyQuestions": [
{
"questionText": "our overall opinion of the property",
"questionHelp": "some help 15",
"sortOrder": 1,
"isActive": true,
"questionType": "TEXT",
"options": ""
}
]
},
{
"name": "About the property",
"surveyQuestions": [
{
"questionText": "type of property",
"questionHelp": "some help 17",
"sortOrder": 1,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "approximate year property was built",
"questionHelp": "some help 18",
"sortOrder": 2,
"isActive": true,
"questionType": "NUMBER",
"options": ""
},
{
"questionText": "approximate year the property was extended",
"questionHelp": "some help 19",
"sortOrder": 3,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "approximate year the property was converted",
"questionHelp": "some help 20",
"sortOrder": 4,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "information relevant to flats and maisonettes",
"questionHelp": "some help 21",
"sortOrder": 5,
"isActive": true,
"questionType": "TEXT",
"options": ""
}
]
}
]
}
Disclaimer: the code looks messy but it's late and it works!
Upvotes: 0
CDP1802
Reputation: 16174
Public Function ToJSON(rng As Range) As String
' Make sure there are two columns in the range
If rng.Columns.Count < 2 Then
ToJSON = CVErr(xlErrNA)
Exit Function
End If
Dim ar, r As Long, c As Long
Dim json As String, json1 As String
ar = rng.Value2
' Skip the first row as it's been used as a header
For r = 2 To UBound(ar)
If Len(ar(r, 1)) > 0 Then
' close off previous name
If Len(json) > 0 Then
' Strip out the last comma
json = Left(json, Len(json) - 1)
json = json & vbCrLf & "]},"
End If
' start new name
json = json & vbCrLf & "{ ""name"" : """ & ar(r, 1) & """," & vbCrLf & _
"""surveyQuestions"": ["
End If
If Len(ar(r, 2)) > 0 Then
' build column data json
json1 = ""
For c = 2 To UBound(ar, 2)
If Len(json1) > 0 Then json1 = json1 & "," & vbCrLf
json1 = json1 & " """ & ar(1, c) & """:""" & ar(r, c) & """"
Next
' add into json
json = json & vbCrLf & "{" & json1 & vbCrLf & "},"
End If
Next
' Strip out the last comma
json = Left(json, Len(json) - 1)
ToJSON = "{" & vbCrLf & """sections"": [" _
& json & "]}]" & vbCrLf & "}"
End Function
Upvotes: 0
Алексей Р
Reputation: 7627
If you want to arrange the text in json structure manner, you can use vbTab and vbLf:
Public Function ToJSON(rng As Range) As String
' Make sure there are two columns in the range
If rng.Columns.Count < 2 Then
ToJSON = CVErr(xlErrNA)
Exit Function
End If
Dim dataLoop, headerLoop As Long
' Get the first row of the range as a header range
Dim headerRange As Range: Set headerRange = rng.Rows(1).Cells
' We need to know how many columns are there
Dim colCount As Long: colCount = headerRange.Columns.Count
Dim json As String: json = "["
For dataLoop = 1 To rng.Rows.Count
' Skip the first row as it's been used as a header
If dataLoop > 1 Then
' Start data row
Dim rowJson As String: rowJson = vbLf & vbTab & "{" & vbLf
' Loop through each column and combine with the header
For headerLoop = 1 To colCount
rowJson = rowJson & vbTab & vbTab & """" & headerRange.Value2(1, headerLoop) & """" & ":"
rowJson = rowJson & """" & rng.Value2(dataLoop, headerLoop) & """"
rowJson = rowJson & "," & vbLf
Next headerLoop
' Strip out the last comma
rowJson = Left(rowJson, Len(rowJson) - 2) & vbLf
' End data row
json = json & rowJson & vbTab & "},"
End If
Next
' Strip out the last comma
json = Left(json, Len(json) - 1)
json = json & vbLf & "]"
ToJSON = json
End Function
Sub test1()
Debug.Print ToJSON(Range("A1").CurrentRegion)
End Sub
Output:
[
{
"name":"About the inspection",
"questionText":"report name",
"questionHelp":"some help 1",
"sortOrder":"1",
"isActive":"TRUE",
"questionType":"TEXT",
"options":""
},
{
"name":"",
"questionText":"surveyor",
"questionHelp":"some help 2",
"sortOrder":"2",
"isActive":"TRUE",
"questionType":"TEXT",
"options":""
},
... and so on
Upvotes: 2
Related Questions
- Parsing JSON to Excel using VBA
- Parse JSON to excel worksheet by JSONConverter
- excel to json with vba
- Write data from JSON to Excel using VBA
- Need to convert an Excel Sheet to its Json format in VBA
- Output array to excel with VBA
- Convert Excel Cells to JSON using VBA
- Parsing JSON data into Excel sheet
- How to import JSON to Excel correctly
- Translate excel inputs into json