Converting a excel column that's in JSON to new columns where the infomation is ordered

Question

I have a column in Excel where I have downloaded data, I would like to create a macro that would take that initial column of data in JSON and then return new columns of data where the information is correctly separated. I would like that the order of the new columns wolud be the following one:

**id            Codi_estacio    Codi_variable      Data_tectura     Valor_lectura   Codi_base**

X9320111230000   X9              32         2023-11-01T00:00:00.000       8             SH
 .               .                   .                     .                  .              . 
 .               .                   .                     .                  .              .                
 .               .                   .                     .                  .              . 

I tried to create a macro that returns the new ordered columns next to the original using a library of jsonconverter that I found on internet, but I'm having some mistakes with the library. I downladed the necessary references in order to apply that code

My code:

Sub ProcesarColumnaJSON()


    Dim columnaOriginal As Range
    Dim celda As Range
    Dim datosJSON As Collection
    Dim resultado As Variant
    Dim i As Integer
    Dim filaResultado As Integer

    

    Set columnaOriginal = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    
    
    filaResultado = 1
    
    
    For Each celda In columnaOriginal
       
        Set datosJSON = JsonConverter.ParseJson(celda.Value)
        
       
        ReDim resultado(1 To 1, 1 To datosJSON.Count)
        i = 1
        For Each key In datosJSON
            resultado(1, i) = datosJSON(key)
            i = i + 1
        Next key
        
        
        Range(Cells(filaResultado, 2), Cells(filaResultado, UBound(resultado, 2) + 1)).Value =   resultado
        
        
        filaResultado = filaResultado + 1
    Next celda
End Sub

Answer 1

• JsonConverter is a powerful tool. Dictionary class module is necessary.
• As your json data is simple, VBA Split is a good option too.

Option Explicit

Sub demo()
    Dim arrData, arrRes(), aTxt, aItem, sKey
    Dim RowCnt As Long, ColCnt As Long
    Dim i As Long, j As Long, k As Long
    Const SEP_CHR1 = ""","""
    Const SEP_CHR2 = """:"""
    ' Get row counts and col counts
    RowCnt = Cells(Rows.Count, 1).End(xlUp).Row
    ColCnt = Len(Range("A1")) - Len(Replace(Range("A1"), SEP_CHR1, "")) + 1
    arrData = Range("A1:A" & RowCnt).Value
    k = 0
    ReDim Preserve arrRes(RowCnt, 1 To ColCnt)
    ' Loop through data
    For i = 1 To UBound(arrData)
        sKey = arrData(i, 1)
        ' Remove the 1st comma
        If Left(sKey, 1) = SEP_CHR1 Then sKey = Mid(sKey, 2)
        aTxt = Split(sKey, SEP_CHR1)
        k = k + 1
        For j = 0 To UBound(aTxt)
            aItem = Split(aTxt(j), SEP_CHR2)
            If i = 1 Then arrRes(0, j + 1) = Replace(aItem(0), Chr(34), "") ' load header
            arrRes(k, j + 1) = "'" & Replace(aItem(1), Chr(34), "")
        Next j
    Next i
    Sheets.Add
    Range("A1").Resize(RowCnt + 1, ColCnt).Value = arrRes
End Sub

Microsoft documentation:

Split function

Answer 2

Option Explicit
 
Sub ProcessJson()
 
    Dim i As Long, j As Long, lastrow As Long
    Dim data As Object, k, s As String
    With Sheet1
        lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
       
        For i = 1 To lastrow
       
            ' parse string
            s = .Cells(i, 1)
            If Left(s, 1) = "," Then s = Mid(s, 2)
            Set data = JsonConverter.parseJson("{" & s & "}")
           
            ' size array
            If i = 1 Then
                ReDim ar(1 To lastrow + 1, 1 To data.Count + 1)
            End If
             
            ' string in column a
            ar(i + 1, 1) = s
            j = 2
           
            ' fill columns
            For Each k In data.Keys
                ' header
                If i = 1 Then
                    ar(1, j) = k
                End If
                ar(i + 1, j) = data(k)
                j = j + 1
            Next
        Next
    End With
   
    Sheet2.Range("A1").Resize(UBound(ar), UBound(ar, 2)) = ar
    MsgBox lastrow & " lines processed", vbInformation
 
End Sub