Start off by hiding all text, then unhiding the paragraphs containing the found text. There is no need to do any looping:
Code:
Sub Demo()
Application.ScreenUpdating = False
StrFnd = InputBox("Find Text with Wildcard")
If Trim(StrFnd) = "" Then Exit Sub
With ActiveDocument.Range
.Font.Hidden = True
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[!^13]@" & StrFnd & "*^13"
.Font.Hidden = True
.Replacement.Font.Hidden = False
.Replacement.Text = "^&"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub