Sub ClearHilites()
  Dim oRngStory As Range
  For Each oRngStory In ActiveDocument.StoryRanges
    With oRngStory.Find
      .Highlight = True
      Do While .Execute
        Select Case oRngStory.HighlightColorIndex
          Case wdTurquoise, wdPink, 9999999
           oRngStory.HighlightColorIndex = wdNoHighlight
           oRngStory.Collapse 0
        End Select
      Loop
    End With
  Next
End Sub