Attribute VB_Name = "CleanDefinedNames"
Option Explicit

' ============================================================
'  CleanDefinedNames  -  removes legacy/junk defined names
'  Keeps a whitelist of real names; skips _xlnm built-ins.
'  Excel Tables are not in the Names collection, so they are
'  never touched. RUN ON A COPY FIRST.
' ============================================================
Sub CleanDefinedNames()
    Dim nm As Name
    Dim keep As Object
    Dim deleted As Long, kept As Long, skipped As Long, failed As Long
    Dim report As String, failedList As String, nmName As String
    Dim i As Long

    Set keep = CreateObject("Scripting.Dictionary")
    keep.CompareMode = vbTextCompare      ' case-insensitive

    ' ---- defined names to KEEP (point to Cover cells) ----
    keep.Add "Report_Date", 1
    keep.Add "Value_Base", 1
    keep.Add "FSPR_Date", 1

    ' ---- Excel Tables: not in Names collection, listed for safety ----
    keep.Add "Addbacks.key", 1
    keep.Add "Company.Codes", 1
    keep.Add "DC.Code", 1
    keep.Add "Dept", 1
    keep.Add "Entity", 1
    keep.Add "Forecasting.Periods", 1
    keep.Add "Levels", 1
    keep.Add "Months", 1
    keep.Add "Period", 1
    keep.Add "Period_end", 1
    keep.Add "Plant.Codes", 1
    keep.Add "SalesData", 1
    keep.Add "Segm", 1
    keep.Add "Statement", 1
    keep.Add "TB", 1
    keep.Add "TB.EBITDA2", 1
    keep.Add "Table4", 1

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Iterate backwards (deleting while looping)
    For i = ThisWorkbook.Names.Count To 1 Step -1
        Set nm = ThisWorkbook.Names(i)

        ' Reading .Name can itself raise on corrupt entries
        nmName = vbNullString
        On Error Resume Next
        nmName = nm.Name
        On Error GoTo 0

        If Len(nmName) > 0 And keep.Exists(nmName) Then
            kept = kept + 1
        ElseIf InStr(1, nmName, "_xlnm.", vbTextCompare) > 0 Then
            ' Built-in print areas / titles - leave alone
            skipped = skipped + 1
        Else
            ' Corrupt names (=#NAME?, illegal chars) make Excel re-validate
            ' and throw 1004 on .Delete. Swallow, try a fallback, and keep going.
            On Error Resume Next
            Err.Clear
            nm.Delete
            If Err.Number <> 0 Then
                Err.Clear
                nm.Visible = True       ' un-hide, sometimes lets it delete
                nm.Delete
            End If
            If Err.Number <> 0 Then
                failed = failed + 1
                If Len(failedList) < 1500 Then _
                    failedList = failedList & nmName & vbCrLf
            Else
                deleted = deleted + 1
            End If
            On Error GoTo 0
        End If
    Next i

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    report = "Done." & vbCrLf & _
             "Deleted: " & deleted & vbCrLf & _
             "Kept (whitelist): " & kept & vbCrLf & _
             "Skipped (_xlnm built-ins): " & skipped & vbCrLf & _
             "Failed (corrupt - need XML fix): " & failed & vbCrLf & _
             "Remaining names: " & ThisWorkbook.Names.Count
    If failed > 0 Then report = report & vbCrLf & vbCrLf & _
             "First few that failed:" & vbCrLf & failedList
    MsgBox report, vbInformation, "CleanDefinedNames"
End Sub