Option Explicit

'========================
' Helpers
'========================

Private Function CleanText(ByVal v As Variant) As String
    Dim s As String
    If IsError(v) Or IsEmpty(v) Then
        CleanText = ""
        Exit Function
    End If
    s = CStr(v)
    s = Replace(s, ChrW(160), " ") ' NBSP -> space
    CleanText = Trim$(s)
End Function

Private Function FindHeaderCol(ws As Worksheet, headerText As String, headerRow As Long) As Long
    Dim lastCol As Long, c As Long, v As String
    lastCol = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).Column

    For c = 1 To lastCol
        v = CleanText(ws.Cells(headerRow, c).Value)
        If StrComp(v, headerText, vbTextCompare) = 0 Then
            FindHeaderCol = c
            Exit Function
        End If
    Next c

    FindHeaderCol = 0
End Function

Private Function ParseDouble(ByVal v As Variant) As Double
    Dim s As String

    If IsError(v) Or IsEmpty(v) Then
        ParseDouble = 0#
        Exit Function
    End If

    If IsNumeric(v) Then
        ParseDouble = CDbl(v)
        Exit Function
    End If

    s = CleanText(v)
    s = Replace(s, " ", "")
    s = Replace(s, ",", ".") ' comma decimals -> dot decimals

    If Len(s) = 0 Or Not IsNumeric(s) Then
        ParseDouble = 0#
    Else
        ParseDouble = CDbl(s)
    End If
End Function

Private Function TryParseDateSerial(ByVal v As Variant, ByRef outSerial As Double) As Boolean
    Dim s As String, datePart As String, timePart As String
    Dim parts() As String, dparts() As String
    Dim yy As Integer, mm As Integer, dd As Integer
    Dim hh As Integer, nn As Integer, ss As Integer

    outSerial = 0#
    TryParseDateSerial = False

    If IsError(v) Or IsEmpty(v) Then Exit Function

    If IsDate(v) Then
        outSerial = CDbl(CDate(v))
        TryParseDateSerial = True
        Exit Function
    End If

    s = CleanText(v)
    If Len(s) = 0 Then Exit Function

    s = Replace(s, "-", "/")
    parts = Split(s, " ")

    datePart = parts(0)
    If UBound(parts) >= 1 Then timePart = parts(1) Else timePart = "00:00"

    dparts = Split(datePart, "/")
    If UBound(dparts) <> 2 Then Exit Function

    If Not IsNumeric(dparts(0)) Or Not IsNumeric(dparts(1)) Or Not IsNumeric(dparts(2)) Then Exit Function

    yy = CInt(dparts(0))
    mm = CInt(dparts(1))
    dd = CInt(dparts(2))

    hh = 0: nn = 0: ss = 0
    parts = Split(timePart, ":")
    If UBound(parts) >= 0 And IsNumeric(parts(0)) Then hh = CInt(parts(0))
    If UBound(parts) >= 1 And IsNumeric(parts(1)) Then nn = CInt(parts(1))
    If UBound(parts) >= 2 And IsNumeric(parts(2)) Then ss = CInt(parts(2))

    On Error GoTo BadDate
    outSerial = CDbl(DateSerial(yy, mm, dd)) + (TimeSerial(hh, nn, ss) / 86400#)
    TryParseDateSerial = True
    Exit Function

BadDate:
    outSerial = 0#
    TryParseDateSerial = False
End Function

'========================
' Main macro
'========================

Public Sub BuildOrganizedReport()
    Dim wsSrc As Worksheet, wsOut As Worksheet
    Dim headerRow As Long: headerRow = 1

    Set wsSrc = ThisWorkbook.Worksheets(1)

    Dim colFrom As Long, colTo As Long, colDT As Long, colDur As Long, colCost As Long, colProfit As Long
    colFrom = FindHeaderCol(wsSrc, "From number", headerRow)
    colTo = FindHeaderCol(wsSrc, "To number", headerRow)
    colDT = FindHeaderCol(wsSrc, "Call initiated", headerRow)
    colDur = FindHeaderCol(wsSrc, "Call duration", headerRow)
    colCost = FindHeaderCol(wsSrc, "Call cost", headerRow)
    colProfit = FindHeaderCol(wsSrc, "Call profit", headerRow)

    If colFrom = 0 Or colTo = 0 Or colDT = 0 Or colDur = 0 Or colCost = 0 Or colProfit = 0 Then
        MsgBox "Headers not found. Expected:" & vbCrLf & _
               "From number, To number, Call initiated, Call duration, Call cost, Call profit", vbCritical
        Exit Sub
    End If

    Dim lastRow As Long
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, colFrom).End(xlUp).Row
    If lastRow <= headerRow Then
        MsgBox "No data rows found.", vbExclamation
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    On Error Resume Next
    ThisWorkbook.Worksheets("Organized").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    Set wsOut = ThisWorkbook.Worksheets.Add(After:=wsSrc)
    wsOut.Name = "Organized"

    ' Keep leading zeros in To Number
    wsOut.Columns("B").NumberFormat = "@"

    ' Headers
    With wsOut
        .Range("A1").Value = "From Number"
        .Range("B1").Value = "To Number"
        .Range("C1").Value = "Call Initiated"
        .Range("D1").Value = "Call Duration (minutes)"
        .Range("E1").Value = "Call Cost"
        .Range("F1").Value = "Call Profit"
        .Range("G1").Value = "Totals"
        .Range("A1:G1").Font.Bold = True
    End With

    Dim r As Long, outRow As Long
    outRow = 2

    For r = headerRow + 1 To lastRow
        Dim fromVal As String
        fromVal = CleanText(wsSrc.Cells(r, colFrom).Value)
        fromVal = Replace(fromVal, " ", "")
        fromVal = Replace(fromVal, ChrW(160), "")
        If Len(fromVal) = 0 Then GoTo ContinueRow

        Dim toVal As String
        toVal = CleanText(wsSrc.Cells(r, colTo).Value)
        toVal = Replace(toVal, ChrW(160), "")
        toVal = Replace(toVal, " ", "")
        wsOut.Cells(outRow, 2).NumberFormat = "@"

        Dim dtSerial As Double, hasDate As Boolean
        hasDate = TryParseDateSerial(wsSrc.Cells(r, colDT).Value, dtSerial)

        Dim durMin As Double, costVal As Double, profitVal As Double
        durMin = ParseDouble(wsSrc.Cells(r, colDur).Value) / 60#
        costVal = ParseDouble(wsSrc.Cells(r, colCost).Value)
        profitVal = ParseDouble(wsSrc.Cells(r, colProfit).Value)

        wsOut.Cells(outRow, 1).Value = fromVal
        wsOut.Cells(outRow, 2).Value = toVal
        If hasDate Then
            wsOut.Cells(outRow, 3).Value = dtSerial
        Else
            wsOut.Cells(outRow, 3).Value = CleanText(wsSrc.Cells(r, colDT).Value)
        End If
        wsOut.Cells(outRow, 4).Value = durMin
        wsOut.Cells(outRow, 5).Value = costVal
        wsOut.Cells(outRow, 6).Value = profitVal
        wsOut.Cells(outRow, 7).Value = ""

        outRow = outRow + 1

ContinueRow:
    Next r

    Dim dataLastRow As Long
    dataLastRow = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp).Row
    If dataLastRow < 2 Then GoTo Cleanup

    wsOut.AutoFilterMode = False

    wsOut.Range("C:C").NumberFormat = "hh:mm dd/mm/yyyy"
    wsOut.Range("D:D").NumberFormat = "0.00"
    wsOut.Range("E:F").NumberFormat = "0.000000"
    wsOut.Columns("A:G").AutoFit

    With wsOut.Range("A:G")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    With wsOut.Sort
        .SortFields.Clear
        .SortFields.Add Key:=wsOut.Range("A2:A" & dataLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=wsOut.Range("D2:D" & dataLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange wsOut.Range("A1:G" & dataLastRow)
        .Header = xlYes
        .Apply
    End With

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

    Dim i As Long, k As String
    For i = 2 To dataLastRow
        k = CStr(wsOut.Cells(i, 1).Value)
        If Not counts.Exists(k) Then counts.Add k, 0
        counts(k) = CLng(counts(k)) + 1
    Next i

    wsOut.Cells.RemoveSubtotal
    wsOut.Range("A1:G" & dataLastRow).Subtotal _
        GroupBy:=1, _
        Function:=xlSum, _
        TotalList:=Array(4, 5, 6), _
        Replace:=True, _
        PageBreaks:=False, _
        SummaryBelowData:=True

    Dim last2 As Long, lbl As String
    last2 = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp).Row

    For i = 2 To last2
        lbl = CStr(wsOut.Cells(i, 1).Value)
        If Len(lbl) > 6 And Right$(lbl, 6) = " Total" Then
            k = Left$(lbl, Len(lbl) - 6)
            k = Replace(k, ChrW(160), "")
            k = Replace(k, " ", "")
            k = Trim$(k)

            If counts.Exists(k) Then
                wsOut.Cells(i, 7).Value = "Calls: " & CStr(counts(k))
            Else
                wsOut.Cells(i, 7).Value = "Calls: 0"
            End If
        End If
    Next i

    wsOut.AutoFilterMode = False
    wsOut.Range("C:C").NumberFormat = "hh:mm dd/mm/yyyy"
    wsOut.Range("D:D").NumberFormat = "0.00"
    wsOut.Range("E:F").NumberFormat = "0.000000"
    wsOut.Columns("B").NumberFormat = "@"
    wsOut.Columns("A:G").AutoFit

    With wsOut.Range("A:G")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    ' Freeze top row (must be INSIDE the macro)
    wsOut.Activate
    ActiveWindow.FreezePanes = False
    wsOut.Range("A2").Select
    ActiveWindow.FreezePanes = True

Cleanup:
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True

    MsgBox "Done. Check the 'Organized' sheet.", vbInformation
End Sub