Paul Trowbridge
c0d4d3ac84
Whitelist-keep deletion of legacy/corrupt workbook defined names (Bloomberg/SAP/Lotus debris); keeps real names + Excel tables. Error-handles corrupt =#NAME? entries. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
97 lines
3.3 KiB
QBasic
97 lines
3.3 KiB
QBasic
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
|