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
                .ClearFormatting
                .Style = oStyle.NameLocal
                .Execute FindText:="", Format:=True
                If .Found = False Then oStyle.Delete
            End With
        End If
    Next oStyle
   
ErrorHandler:
    Application.ScreenUpdating = False
   
End Sub