CODEWITHSUNDEEP
jsonexcelvbaconverters
Vicky Arora
Vicky Arora

Reputation: 1

Need to convert an Excel Sheet to its Json format in VBA

Excel Sample:

enter image description here

Below are the sample Json. Would like to convert Json as like below.

{
    "student": {
        "id": "",
        "firstName": "",
        "lastName": "",
        "age": "",
        "gender": "",
        "education": {
            "degree": {
                "id":"",
                "specialization":""
            },
            "college": {
                "id": "",
                "name":"",
                "cityCode": "",
                "county":""
            }
        },
        "address": {
            "id": "",
            "streetName":"",
            "cityCode": "",
            "stateCode":"",
            "postalCode": "",
            "county":""
        }
    }
}

Excel file will have fixed 2 columns. Rows can be variable. Instead of students, there can be books, accounts, etc. So the code must be generalized.

Please can anyone help, I am stuck with this for the past a week.

Upvotes: 0

Views: 468

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57683

The following example is using this libaray (https://github.com/VBA-tools/VBA-JSON)

Option Explicit

Public Sub Example()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("JSONdata") ' define your sheet
    
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim Json As Dictionary
    Set Json = New Dictionary

    Dim iRow As Long
    For iRow = 2 To LastRow ' loop through all data rows (skip header)
        Dim SplittedItems() As String
        SplittedItems = Split(ws.Cells(iRow, "A").Value, ".")
        
        Dim CurrentJson As Dictionary
        Set CurrentJson = Json
        
        Dim Item As String
        
        ' create entities
        Dim i As Long
        For i = LBound(SplittedItems) To UBound(SplittedItems)
            Item = SplittedItems(i)
            If Not CurrentJson.Exists(Item) Then
                CurrentJson.Add Item, New Dictionary
            End If
            Set CurrentJson = CurrentJson(Item)
        Next i
        
        ' create fields
        If Not CurrentJson.Exists(ws.Cells(iRow, "B").Value) Then
            SplittedItems = Split(ws.Cells(iRow, "B").Value, ".")
            For i = LBound(SplittedItems) To UBound(SplittedItems)
                Item = SplittedItems(i)
                If Not CurrentJson.Exists(Item) Then
                    CurrentJson.Add Item, IIf(i = UBound(SplittedItems), vbNullString, New Dictionary)
                End If
                If Not i = UBound(SplittedItems) Then
                    Set CurrentJson = CurrentJson(Item)
                End If
            Next i
        End If
    Next iRow
    
    ' Convert dictionaries to JSON and print
    Debug.Print JsonConverter.ConvertToJson(Json, " ", 1)
End Sub

And turns this data

Entity Fields
student id
student firstName
student lastName
student age
student gender
student.education degree.id
student.education degree.specification
student.education.college id
student.education.college name
student.education.college cityCode
student.education.college country
student.address id
student.address streetName
student.address cityCode
student.address stateCode
student.address postalCode
student.address country

into the following JSON string

{
  "student": {
   "id": "",
   "firstName": "",
   "lastName": "",
   "age": "",
   "gender": "",
   "education": {
    "degree": {
     "id": "",
     "specification": ""
    },
    "college": {
     "id": "",
     "name": "",
     "cityCode": "",
     "country": ""
    }
   },
   "address": {
    "id": "",
    "streetName": "",
    "cityCode": "",
    "stateCode": "",
    "postalCode": "",
    "country": ""
   }
  }
 }

Note that your raw data does not look consistent and I believe that this

Entity Fields
student.education degree.id
student.education degree.specification

should actually be this

Entity Fields
student.education.degree id
student.education.degree specification

Then the code of the field creation would simplify to

' create fields
If Not CurrentJson.Exists(ws.Cells(iRow, "B").Value) Then
    CurrentJson.Add Item, vbNullString
End If

Upvotes: 3

Related Questions