Compare JSON data and splitting into corrected codes, deleted codes and added codes

Hi All,

Hope you are doing well!..I am trying to extract the difference in the dcode entered by a coder and an auditor on a transaction (a transaction is represented by a combination of Billid and ctextid)..(the dcode is present in the info column which is JSON)...

Going by the created date time for a transaction the coder enters the dcode at the earliest datetime for a transaction and the auditor enters at a later created time for the same transaction.

There are only two rows for a single transaction -the earliest created datetime has the JSON (dcodes) entered by the coder and the later created datetime has the JSON(dcodes) entered by the auditor..Now I need to pick up the codername as the first user (earliest created datetime )in a transaction.Now I need to compare the earliest created JSON with the second created JSON( and pull out what dcodes were entered by the coder was corrected by the auditor ,what dcodes was deleted by the auditor,what dcodes was added by the auditor (in only this case the code entered by the auditor needs to be picked up as it is a newly entered code ,in the previous two cases the dcode by the coder needs to be picked up)..

Also for determining the corrected codes (the matching can be done on description to check if the description of coder and auditor matches and in that sequence the codes entered by the coder that are changed by the auditor need to be taken )...Can you please help me with this..Attached the excel sheet with the input (input data) and output (expected data) tabs..

Already posted link:
https://www.excelforum.com/excel-for...ml#post5431624

Thanks,
Arun

chandramouliarun,

This is how I interpret the problem and my result is slightly different from yours.

Sub test()
    Dim a, e, i As Long, ii As Long, dic As Object, m
    Set dic = CreateObject("Scripting.Dictionary")
    a = Sheets("input ").Cells(1).CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        If Not dic.exists(a(i, 1)) Then
            Set dic(a(i, 1)) = CreateObject("Scripting.Dictionary")
            dic(a(i, 1))(a(1, 1)) = a(i, 1)
            dic(a(i, 1))(a(1, 2)) = a(i, 2)
            dic(a(i, 1))("codername") = a(i, 4)
            GetDetails a(i, 3), a(i, 1), dic, True
        Else
            GetDetails a(i, 3), a(i, 1), dic, False
        End If
    Next
    With Sheets("output").Cells(1).CurrentRegion
        .Offset(1).ClearContents
        For i = 0 To dic.Count - 1
            For ii = 1 To .Columns.Count
                .Cells(i + 2, ii) = dic.items()(i)(.Cells(1, ii).Value)
            Next
        Next
    End With
End Sub

Private Sub GetDetails(ByVal txt As String, myKey, dic As Object, flg As Boolean)
    Dim m As Object
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = """description"": *""(.+?)"".*[\r\n]+.*""dCode"": *""(.+?)"""
        For Each m In .Execute(txt)
            If flg Then
                dic(myKey)(m.submatches(0)) = m.submatches(1)
            Else
                If dic(myKey).exists(m.submatches(0)) Then
                    If dic(myKey)(m.submatches(0)) <> m.submatches(1) Then
                        dic(myKey)("correctedcode") = dic(myKey)("correctedcode") & _
                        IIf(dic(myKey)("correctedcode") <> "", ", ", "") & m.submatches(1)
                        dic(myKey)("deletedcode") = dic(myKey)("deletedcode") & _
                        IIf(dic(myKey)("deletedcode") <> "", ",", "") & dic(myKey)(m.submatches(0))
                        dic(myKey)(m.submatches(0)) = m.submatches(1)
                    End If
                Else
                    dic(myKey)("addedcode") = m.submatches(1)
                End If
            End If
        Next
    End With
End Sub

@ Jindon: This is Awesome!!!...This is almost what I wanted.. Just that For deleted codes need to have whatever dcode is not present in the 2nd JSon(the one with later created) that was there in the 1st json(earlier created), ...So for the current output for Billid 7789 and ctextid 60045 the deleted code should be Z003345,H678,U8923,Y98620 ... Can you please help me here!

Thank you so much for your help!..

Thanks,
Arun

What is the definition of "correctedcode"?

Try replace "Private Sub GetDetails" with following code and see how it goes.

Private Sub GetDetails(ByVal txt As String, myKey, dic As Object, flg As Boolean)
    Dim m As Object, e
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = """description"": *""(.+?)"".*[\r\n]+.*""dCode"": *""(.+?)"""
        For Each m In .Execute(txt)
            If flg Then
                dic(myKey)(m.submatches(0)) = m.submatches(1)
            Else
                If dic(myKey).exists(m.submatches(0)) Then
                    If dic(myKey)(m.submatches(0)) <> m.submatches(1) Then
                        dic(myKey)("correctedcode") = dic(myKey)("correctedcode") & _
                        IIf(dic(myKey)("correctedcode") <> "", ", ", "") & dic(myKey)(m.submatches(0))
                    End If
                    dic(myKey).Remove m.submatches(0)
                Else
                    dic(myKey)("addedcode") = m.submatches(1)
                End If
            End If
        Next
    End With
    If Not flg Then
        For Each e In dic(myKey)
            Select Case e
                Case "Billid", "Ctextid", "codername", "correctedcode", "addedcode", "deletedcode"
                Case Else
                    dic(myKey)("deletedcode") = dic(myKey)("deletedcode") & _
                    IIf(dic(myKey)("deletedcode") <> "", ", ", "") & dic(myKey)(e)
            End Select
        Next
    End If
End Sub

@ Jindon ...I am getting the below as outputoutput.jpg