Public Sub Main()
On Error GoTo BYE
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' First we'll check to see if "DeleteStyle" exists as a style
X = ActiveDocument.Styles.Count
For i = 1 To X
    If "DeleteStyle" = ActiveDocument.Styles(i) Then
        GoTo CONTINUE
    End If
Next

' If we dropped to here -- we need to create the new style
ActiveDocument.Styles.Add Name:="DeleteStyle", Type:=wdStyleTypeParagraph
With ActiveDocument.Styles("DeleteStyle")
    .AutomaticallyUpdate = False
    .BaseStyle = "Normal"
    .NextParagraphStyle = "DeleteStyle"
End With
With ActiveDocument.Styles("DeleteStyle").Font
    .Bold = True
    .ColorIndex = wdRed
End With

' At this point we've either confirmed or created our "DeleteStyle" style
CONTINUE:
Count = 0
MyDeleteTerm$ = InputBox("Enter your term by which to locate paragraphs to delete.", _
            " Delete Paragraphs Containing")
If StrPtr(MyDeleteTerm$) = 0 or Len(MyDeleteTerm$) = 0 Then Exit Sub
Selection.HomeKey Unit:=wdStory
With Selection.Find
    .Text = MyDeleteTerm$
    .MatchWildcards = False
    .Replacement.Text = ""
    .Wrap = wdFindStop
    .Forward = True
End With
Selection.Find.Execute
If Selection.Find.Found Then
    ActiveDocument.Bookmarks("\para").Select
    Btn = MsgBox("Is the selected paragraph an example of what you wish to delete" & _
            " throughout the document?", vbOKCancel + vbQuestion, _
            " Deletion Example")
    If Btn = vbCancel Then Exit Sub
Else
    Btn = MsgBox("Term not found in the document!", vbOKOnly + vbExclamation, _
            " Term Location Error!")
    Exit Sub
End If
Selection.HomeKey Unit:=wdStory' Start at top of the document
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("DeleteStyle")
With Selection.Find
    .Text = MyDeleteTerm$' Term to delete
    .Replacement.Text = "^&"' Find/Replace with itself in the Delete style
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' The need to first replace the style (below) with a string, is because Word doesn't like to replace a style with nothing -- though it has no problem replacing a string with nothing.

Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("DeleteStyle")' Locating the style
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = ""
    .Replacement.Text = "%&#@"' Replacing with a unique character string
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "%&#@"' Locating the aforementioned unique string
    .Replacement.Text = ""' Replacing it with nothing
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
BYE:
End Sub