Excel excess: how to remove unwanted styles with VBA

Long story short, I just opened a workbook with 37,000 styles :(. Apparently this is a common problem). Allen Wyatt of ExcelTips suggests deleting non-builtin styles. But I had over 6,000 of those. And some of my user-defined styles are important!

My solution is to remove any style whose name ends with a number, keeping one of each base-name. Cells with deleted styles get “Normal”.

The code uses regular expressions to trim trailing numbers from style names, and uses a dictionary for the set of base names.

Option Explicit

Sub DeduplicateStyles()
  Call DeleteDupStyles(Workbooks("NEW_multi_sector.xlsx"))
End Sub

Sub DeleteDupStyles(wb As Workbook)
  Dim sty As style
  Dim intRet As Integer
  Dim dict As New Scripting.Dictionary
  Dim count As Integer: count = 0

  For Each sty In wb.styles
    Dim n As String: n = trimTrailingNumbers(sty.Name)
    If dict.Exists(n) Then
      ' Debug.Print ("deleting: " & sty.Name)
      On Error Resume Next
      sty.Delete
      If Err.Number <> 0 Then
        Debug.Print ("ERROR deleting: " & sty.Name)
      End If
    Else
      Debug.Print ("keeping: " & sty.Name)
      dict.Add n, 1
    End If

    count = count + 1
    If count Mod 100 = 0 Then
      DoEvents
    End If
  Next sty
End Sub

Function regexp(pattern As String) As regexp
  Dim rx As New regexp
  With rx
    .Global = True
    .MultiLine = False
    .IgnoreCase = False
    .pattern = pattern
  End With
  Set regexp = rx
End Function

Function trimTrailingNumbers(s As String) As String
  trimTrailingNumbers = regexp("( \d+)+$").Replace(s, "")
End Function