Delete Unused Styles

I don’t recall where I found this on the interwebs. It seems to work well. If anyone finds the original source, please comment and I’ll give the credit where credit is due!

Sub DeleteUnusedStyles()
    Dim oStyle As Style
    On Error GoTo ErrorHandler
    Application.ScreenUpdating = False ' try to speed it up
    For Each oStyle In ActiveDocument.Styles
        'Only check out non-built-in styles
        If oStyle.BuiltIn = False Then
            With ActiveDocument.Content.Find
                .Style = oStyle.NameLocal
                .Execute FindText:="", Format:=True
                If .Found = False Then oStyle.Delete
            End With
        End If
    Next oStyle
    Application.ScreenUpdating = False
End Sub

Leave a Reply