Sub HideUnusedStyles()
Dim Doc As Document, bDel As Boolean
Dim Rng As Range, StlNm As String, i As Long
Application.ScreenUpdating = False
On Error Resume Next
Set Doc = ActiveDocument
With Doc
  For i = .Styles.Count To 1 Step -1
    With .Styles(i)
        bDel = True: StlNm = .NameLocal
        For Each Rng In Doc.StoryRanges
          With Rng
            With .Find
              .ClearFormatting
              .Format = True
              .Style = StlNm
              .Execute
            End With
            If .Find.Found = True Then
              bDel = False
              Exit For
            End If
          End With
        Next
        If bDel = True Then .Visibility = False
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub