Sub StylesInUseForReal() 
    Dim oStyle As Style 
    Dim sStyle As String 
    Dim actDoc As Document 
    Dim newDoc As Document 
    Dim sect As section 
    Dim rng As Range 
    Dim sName As String 
    Set actDoc = ActiveDocument 
    sName = actDoc.FullName 
    StatusBar = "Analyzing syles in use! Please be patient! This may take some time." & _ 
    "Hit Ctrl-Break to stop the macro." 
    On Error Resume Next 
    For Each oStyle In actDoc.Styles 
        If oStyle.InUse And IsStyleInUseInDoc(oStyle, actDoc) Then 
            oStyle.Visibility = False 
        End If 
    Next oStyle 
    StyleShowStyleInUse 
    MsgBox "Styles in Use Macro is Complete." 
End Sub 
 
Function IsStyleInUseInDoc(ByVal oStyle As Style, ByVal oDoc As Document) As Boolean 
    Dim oRange As Range 
    Dim bReturn As Boolean 
    bReturn = False 
    For Each oRange In oDoc.StoryRanges 
        If IsStyleInRange(oStyle, oRange) = True Then 
            bReturn = True 
        End If 
    Next oRange 
    IsStyleInUseInDoc = bReturn 
End Function 

 Function IsStyleInRange(ByVal oStyle As Style, ByVal oRange As Range) As Boolean 
    With oRange.Find 
        .ClearFormatting 
        .Style = oStyle 
        .Forward = True 
        .Format = True 
        .Text = "" 
        .Execute 
    End With 
    If oRange.Find.Found = True Then 
        IsStyleInRange = True 
    Else 
        IsStyleInRange = False 
    End If 
End Function 
 
Sub StyleShowStyleInUse() 
    ActiveDocument.FormattingShowFont = False 
    ActiveDocument.FormattingShowParagraph = False 
    ActiveDocument.FormattingShowNumbering = False 
    ActiveDocument.FormattingShowNextLevel = False 
    ActiveDocument.FormattingShowFilter = wdShowFilterStylesInUse 
    ActiveDocument.StyleSortMethod = wdStyleSortByName 
End Sub