Sub New_FINAL_RECON_AUDIT_PROOF()

    Dim wsPR        As Worksheet
    Dim ws2B        As Worksheet
    Dim wsRec       As Worksheet
    Dim wsMatch     As Worksheet
    Dim wsNotMatch  As Worksheet

    Set wsPR = Sheets("Purchase_Register")
    Set ws2B = Sheets("GSTR-2B_Data")
    Set wsRec = Sheets("Reconciliation")
    Set wsMatch = Sheets("Matched_Data")
    Set wsNotMatch = Sheets("Not_Matched")

    wsRec.Cells.Clear
    wsMatch.Cells.Clear
    wsNotMatch.Cells.Clear

    wsRec.Range("A1:H1") = Array("GSTIN", "Supplier", "Invoice", "Books Total", "2B Total", "Diff", "Status", "Remarks")
    wsMatch.Range("A1:G1") = Array("GSTIN", "Supplier", "Invoice", "Books", "2B", "Status", "Type")
    wsNotMatch.Range("A1:G1") = Array("GSTIN", "Supplier", "Invoice", "Books", "2B", "Status", "Reason")

    With wsRec.Range("A1:H1")
        .Font.Bold = True
        .Interior.Color = RGB(0, 112, 192)
        .Font.Color = RGB(255, 255, 255)
    End With
    With wsMatch.Range("A1:G1")
        .Font.Bold = True
        .Interior.Color = RGB(0, 112, 192)
        .Font.Color = RGB(255, 255, 255)
    End With
    With wsNotMatch.Range("A1:G1")
        .Font.Bold = True
        .Interior.Color = RGB(0, 112, 192)
        .Font.Color = RGB(255, 255, 255)
    End With

    wsRec.Columns("C").NumberFormat = "@"
wsMatch.Columns("C").NumberFormat = "@"
wsNotMatch.Columns("C").NumberFormat = "@"
wsRec.Columns("C").HorizontalAlignment = xlRight
wsMatch.Columns("C").HorizontalAlignment = xlRight
wsNotMatch.Columns("C").HorizontalAlignment = xlRight

    Dim dictBooks As Object
    Dim dict2B    As Object
    Set dictBooks = CreateObject("Scripting.Dictionary")
    Set dict2B = CreateObject("Scripting.Dictionary")

    Dim i    As Long
    Dim key  As String
    Dim tmp  As Variant

    For i = 2 To wsPR.Cells(wsPR.Rows.Count, 1).End(xlUp).Row

        Dim gstPR      As String
        Dim invPR      As String
        Dim supplierPR As String
        Dim taxPR      As Double

        gstPR = UCase(Trim(wsPR.Cells(i, 1).Value))
        supplierPR = Trim(wsPR.Cells(i, 2).Value)
        invPR = NormalizeInv(GetInvoice_Number(CStr(wsPR.Cells(i, 3).Value)))
        taxPR = ToNum(wsPR.Cells(i, 6)) + ToNum(wsPR.Cells(i, 7)) + ToNum(wsPR.Cells(i, 8))

        If gstPR = "" Or invPR = "" Then GoTo NextPR

        key = gstPR & "|" & invPR

        If dictBooks.exists(key) Then
            tmp = dictBooks(key)
            tmp(0) = tmp(0) + taxPR
            tmp(4) = tmp(4) + 1
            dictBooks(key) = tmp
        Else
            dictBooks.Add key, Array(taxPR, supplierPR, gstPR, invPR, 1)
        End If

NextPR:
    Next i

    For i = 2 To ws2B.Cells(ws2B.Rows.Count, 1).End(xlUp).Row

        Dim gst2B      As String
        Dim inv2B      As String
        Dim supplier2B As String
        Dim tax2B      As Double

        gst2B = UCase(Trim(ws2B.Cells(i, 1).Value))
        supplier2B = Trim(ws2B.Cells(i, 2).Value)
        inv2B = NormalizeInv(GetInvoice_Number(CStr(ws2B.Cells(i, 3).Value)))
        tax2B = ToNum(ws2B.Cells(i, 6)) + ToNum(ws2B.Cells(i, 7)) + ToNum(ws2B.Cells(i, 8))

        If gst2B = "" Or inv2B = "" Then GoTo Next2B

        key = gst2B & "|" & inv2B

        If Not dict2B.exists(key) Then
            dict2B.Add key, Array(tax2B, supplier2B, gst2B, inv2B)
        Else
            tmp = dict2B(key)
            tmp(0) = tmp(0) + tax2B
            dict2B(key) = tmp
        End If

Next2B:
    Next i

    Dim rowRec As Long: rowRec = 2
    Dim rowM   As Long: rowM = 2
    Dim rowN   As Long: rowN = 2

    Dim allKeys As Object
    Set allKeys = CreateObject("Scripting.Dictionary")

    Dim k As Variant
    For Each k In dictBooks.keys
        If Not allKeys.exists(k) Then allKeys.Add k, 1
    Next k
    For Each k In dict2B.keys
        If Not allKeys.exists(k) Then allKeys.Add k, 1
    Next k

    For Each k In allKeys.keys

        Dim booksVal     As Double: booksVal = 0
        Dim val2B_       As Double: val2B_ = 0
        Dim supplierName As String: supplierName = ""
        Dim invDisplay   As String: invDisplay = ""
        Dim gstDisplay   As String: gstDisplay = ""

        If dictBooks.exists(k) Then
            booksVal = dictBooks(k)(0)
            supplierName = dictBooks(k)(1)
            gstDisplay = dictBooks(k)(2)
            invDisplay = dictBooks(k)(3)
        End If

        If dict2B.exists(k) Then
            val2B_ = dict2B(k)(0)
            If supplierName = "" Then supplierName = dict2B(k)(1)
            If gstDisplay = "" Then gstDisplay = dict2B(k)(2)
            If invDisplay = "" Then invDisplay = dict2B(k)(3)
        End If

        Dim diff   As Double: diff = booksVal - val2B_
        Dim status As String: status = ""
        Dim remark As String: remark = ""
        Dim mType  As String: mType = ""

        If dictBooks.exists(k) And dict2B.exists(k) Then
            If Abs(diff) <= 1 Then
                status = "Matched"
                If dictBooks(k)(4) > 1 Then
                    remark = "OK (Split Invoice)"
                    mType = "Split Match"
                Else
                    remark = "OK"
                    mType = "Exact Match"
                End If
            Else
                status = "Mismatch"
                remark = "Value Difference"
                mType = "Invoice Match"
            End If
        ElseIf dictBooks.exists(k) And Not dict2B.exists(k) Then
            status = "Not In 2B"
            remark = "Missing in GSTR-2B"
        ElseIf Not dictBooks.exists(k) And dict2B.exists(k) Then
            status = "Not Found"
            remark = "Missing in Books"
        End If

        wsRec.Cells(rowRec, 1) = gstDisplay
        wsRec.Cells(rowRec, 2) = supplierName
        wsRec.Cells(rowRec, 3) = invDisplay
        wsRec.Cells(rowRec, 4) = booksVal
        wsRec.Cells(rowRec, 5) = val2B_
        wsRec.Cells(rowRec, 6) = diff
        wsRec.Cells(rowRec, 7) = status
        wsRec.Cells(rowRec, 8) = remark

        Dim rngRow As Range
        Set rngRow = wsRec.Range(wsRec.Cells(rowRec, 1), wsRec.Cells(rowRec, 8))
        rngRow.Font.Bold = False
        rngRow.Font.ColorIndex = xlAutomatic

        Select Case status
            Case "Matched"
                rngRow.Font.Bold = True
                rngRow.Font.Color = RGB(0, 0, 255)
            Case "Mismatch", "Not In 2B", "Not Found"
                rngRow.Font.Bold = True
                rngRow.Font.Color = RGB(255, 0, 0)
        End Select

        If status = "Matched" Then
            wsMatch.Cells(rowM, 1) = gstDisplay
            wsMatch.Cells(rowM, 2) = supplierName
            wsMatch.Cells(rowM, 3) = invDisplay
            wsMatch.Cells(rowM, 4) = booksVal
            wsMatch.Cells(rowM, 5) = val2B_
            wsMatch.Cells(rowM, 6) = status
            wsMatch.Cells(rowM, 7) = mType
            rowM = rowM + 1
        Else
            wsNotMatch.Cells(rowN, 1) = gstDisplay
            wsNotMatch.Cells(rowN, 2) = supplierName
            wsNotMatch.Cells(rowN, 3) = invDisplay
            wsNotMatch.Cells(rowN, 4) = booksVal
            wsNotMatch.Cells(rowN, 5) = val2B_
            wsNotMatch.Cells(rowN, 6) = status
            wsNotMatch.Cells(rowN, 7) = remark
            rowN = rowN + 1
        End If

        rowRec = rowRec + 1

    Next k

    wsRec.Columns("A:H").AutoFit
    wsMatch.Columns("A:G").AutoFit
    wsNotMatch.Columns("A:G").AutoFit

    MsgBox "Reconciliation completata!" & vbNewLine & vbNewLine & _
           "Matched:     " & rowM - 2 & vbNewLine & _
           "Not Matched: " & rowN - 2, vbInformation, "Report Finale"

End Sub

Function ToNum(c As Range) As Double
    If IsNumeric(c.Value) Then
        ToNum = CDbl(c.Value)
    Else
        ToNum = 0
    End If
End Function

Function NormalizeInv(inv As String) As String
    inv = Trim(inv)
    Do While Left(inv, 1) = "0" And Len(inv) > 1
        inv = Mid(inv, 2)
    Loop
    NormalizeInv = inv
End Function

Function GetInvoice_Number(inv As String) As String

    Dim oRegex   As Object
    Dim oMatches As Object
    Dim sParts() As String
    Dim sResult  As String
    Dim sPart    As String
    Dim i        As Integer
    Dim j        As Integer
    Dim y1       As Integer
    Dim y2       As Integer
    Dim bIsFY    As Boolean
    Dim nCount   As Integer
    Dim sLast    As String
    Dim sSecLast As String
    Dim sRemain  As String

    Set oRegex = CreateObject("VBScript.RegExp")
    oRegex.Global = True

    inv = Trim(inv)
    If inv = "" Then GetInvoice_Number = "": Exit Function

    If InStr(inv, "/") > 0 Then

        sParts = Split(inv, "/")

        For i = UBound(sParts) To 0 Step -1
            sPart = Trim(sParts(i))
            bIsFY = False
            oRegex.Pattern = "^(\d{2,4})-(\d{2,4})$"
            If oRegex.Test(sPart) Then
                Set oMatches = oRegex.Execute(sPart)
                y1 = CInt(oMatches(0).SubMatches(0)) Mod 100
                y2 = CInt(oMatches(0).SubMatches(1)) Mod 100
                If y2 = (y1 + 1) Mod 100 Then bIsFY = True
            End If
            If Not bIsFY Then
                oRegex.Pattern = "\d+"
                If oRegex.Test(sPart) Then
                    Set oMatches = oRegex.Execute(sPart)
                    sResult = ""
                    For j = 0 To oMatches.Count - 1
                        sResult = sResult & oMatches(j).Value
                    Next j
                    GetInvoice_Number = sResult
                    Exit Function
                End If
            End If
        Next i

    Else

        sParts = Split(inv, "-")
        nCount = UBound(sParts) + 1
        oRegex.Pattern = "^\d{2,4}$"

        Do While nCount >= 2
            sLast = Trim(sParts(nCount - 1))
            sSecLast = Trim(sParts(nCount - 2))
            If oRegex.Test(sLast) And oRegex.Test(sSecLast) Then
                y1 = CInt(sSecLast) Mod 100
                y2 = CInt(sLast) Mod 100
                If y2 = (y1 + 1) Mod 100 Then
                    nCount = nCount - 2
                Else
                    Exit Do
                End If
            Else
                Exit Do
            End If
        Loop

        sRemain = ""
        For i = 0 To nCount - 1
            If i > 0 Then sRemain = sRemain & "-"
            sRemain = sRemain & sParts(i)
        Next i

        oRegex.Pattern = "\d+"
        If oRegex.Test(sRemain) Then
            Set oMatches = oRegex.Execute(sRemain)
            sResult = ""
            For j = 0 To oMatches.Count - 1
                sResult = sResult & oMatches(j).Value
            Next j
            GetInvoice_Number = sResult
        Else
            GetInvoice_Number = ""
        End If

    End If

End Function