Microsoft Office Forums - View Single Post - [Solved] Macro to hide all paragraphs that do not have the found result

jplat · 09-10-2017, 05:41 PM

I work on 200+page long documents and want to write a macro that hide all paragraphs that do not contain the specific words I search for. For example, I want to search for the term "White Rabbit", highlight all the search results and then hide all paragraphs that do not contain this search term.

I put together a macro based on the other macros I found on this forum. It sometimes works really well. But then out of no where it will stop working and crash Microsoft Word (I am using Word 2013 Windows 10 64 bit) and I have to restart the computer to make it work again. Could you help me see what might be the problem? For example, it crashes each time I search for any single word. It occasionally works if I search for multiple words and occasionally not. This is driving me crazy.

Thanks!

Code:

Sub ShowFoundResults()

Application.ScreenUpdating = False
ActiveWindow.View.ShowAll = True

Dim StrFnd As String
Dim DocRange As Range
Dim ParaRange As Range
Dim WasFound As Boolean

StrFnd = InputBox("Find Text with Wildcard")
If Trim(StrFnd) = "" Then Exit Sub

WasFound = False
ActiveDocument.Range.Font.Hidden = True

Set DocRange = ActiveDocument.Range

With DocRange.Find
.ClearFormatting
.Text = StrFnd
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False

Do While .Execute
WasFound = True
Set ParaRange = DocRange.Paragraphs(1).Range
ParaRange.Font.Hidden = False
DocRange.SetRange DocRange.Paragraphs(1).Range.End, _
ActiveDocument.Range.End
Loop
End With

ActiveWindow.View.ShowAll = False

Options.DefaultHighlightColorIndex = wdYellow
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = StrFnd
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

Application.ScreenUpdating = True

End Sub