2

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

ExcelData

Required JSON Format

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
Improve this question
6
  • 2
    Can you explain in more detail what you are not satisfied with the result? Commented Aug 7, 2021 at 9:01
  • 1
    Not answer to your question but you can change the For loop to For dataLoop = 2 To rng.Rows.Count then remove If dataLoop > 1 Then statement if you are going to always skip the 1st row. Commented Aug 7, 2021 at 9:13
  • Because the API does not accept this format @Алексей Р Commented Aug 7, 2021 at 9:20
  • I tried to change as per the given guidance but it converts as it i@Raymond Wu Commented Aug 7, 2021 at 9:21
  • @Arham I already said that won't answer your question. Is this function meant to be for creating this JSON format solely or a general-purpose function? Commented Aug 7, 2021 at 12:08

3 Answers 3

Reset to default
2

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
Improve this answer
Sign up to request clarification or add additional context in comments.

2 Comments

Thank you for having the interest but the required JSON is different. @Алексей Р
Your Excel data does't contains all the tags which are in the JSON sample. Can you share the target JSON which is exactly corresponds to your data?
0 
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
Improve this answer

Comments

0

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!

Improve this answer

1 Comment

Thank you very much its working well as always. @Raymond Wu