diff --git a/CleanDefinedNames.bas b/CleanDefinedNames.bas new file mode 100644 index 0000000..40d765c --- /dev/null +++ b/CleanDefinedNames.bas @@ -0,0 +1,96 @@ +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