Trying to Convert Excel Format into JSON

Admin 1
Viewed 227

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
macos vba excel json
3 Answers

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
user_150353140 
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
user_127045930

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!

user_155979360
Related