Word Macro to select paragraph with specific words and copy to new document-CodePudding

I am trying to create a Word macro that will:

Search for a specific word (i.e. "see")
Select the entire paragraph where that word appears
Make the whole paragraph a different style (i.e. make it all red text)
Do the same thing with a second word (i.e. "blacklist")
Select that whole paragraph and apply a different style (i.e. again, make the paragraph red text)
Copy all paragraphs with the red text style and paste them in to a new word document

Unfortunately, I'm no VBA expert and I'm trying to cobble things together from what I can find online. I have found a great example that will select to the start of the paragraph, but I can't seem to figure out how to select the entire paragraph. Any help is appreciated!

** Sorry - here is the code I currently have. It will find all instances of the word "see" and selects to the start of the paragraph, then changes the color to red... but that's as far as I've gotten, as I am stuck on trying to figure out how to get it to select to the end of the paragraph.

Sub TestOne()
'
' TestOne Macro
'
'
If MsgBox(Prompt:="Would you like to update selected paragraph styles?", Buttons:=vbYesNo   vbQuestion, _
  Title:="Format MD Report") = vbNo Then
  Exit Sub
End If

Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "see"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = False
  End With
  Do While .Find.Execute
    i = i   1
    .Start = .Paragraphs.First.Range.Start
    .Font.Color = wdColorRed
    .Start = .Paragraphs.First.Range.End
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances processed."
End Sub

CodePudding user response：

For example, without needing to create a second document:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrFnd As String
StrFnd = "see|blacklist"
With ActiveDocument.Range
  .Font.Hidden = True
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Replacement.Text = "^&"
    .Font.Hidden = True
    .Replacement.Font.Hidden = False
    .Format = True
    .Forward = True
    .MatchWildcards = True
    .Wrap = wdFindContinue
    For i = 0 To UBound(Split(StrFnd, "|"))
      .Text = "[!^13]@" & Split(StrFnd, "|")(i) & "*^13"
      .Execute Replace:=wdReplaceAll
    Next
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

You could, of course, add a line of code before the final 'End With' to save the document with a new name.

CodePudding user response：

To select the entire paragraph, following the line

.Start = .Paragraphs.First.Range.Start

add

.End = .Paragraphs.First.Range.End

... then to match only whole words, after

.MatchWildcards = False

add

.MatchWholeWord = True

And to run the code for multiple words you should add a parameter to your Sub eg

Sub TestOne(theWord As String)

then replace

.Text = "see"

with

.Text = theWord

And to run your code for each required word, add a Sub such as

Sub RunMe()
    TestOne "see"
    TestOne "blacklist"
End Sub

... optionally, move your MsgBoxes into RunMe()