VBA to Find Word or Phrase then Highlight Entire Paragraph that Follows

Joined
Sep 8, 2016
Messages
12
Reaction score
1
Searching for days trying to find a solution as my code only highlights to the end of the line (as shown below).
I've come across some other commands but not sure how to formulate.

<code>
Sub Find_Highlight_Word_to_End_of_Line()
'BUT NEED IT TO HIGHLIGHT THROUGH END OF PARAGRAPH
Dim sFindText As String
'Start from the top of the document
Selection.HomeKey wdStory
sFindText = "Contractor Shall"
Selection.Find.Execute sFindText
Do Until Selection.Find.Found = False
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Range.HighlightColorIndex = wdYellow
Selection.MoveRight
Selection.Find.Execute
Loop
End Sub
</code>

(ideally, highlighting the below paragraph AND the list that provides further details below the paragraph would be best -but if only the paragraph is achievable, that's better than nothing)

Sample Text Where Lists Exist (and would be nice to pick up in the highlighting):
"The Contractor shall turn in monthly status reports within ten business days after the end of each month. The report should include:
(a) Accomplishments
(b) Meetings and Outcomes
(c) Completed Travel and Purpose of Travel"

I've researched several commands and looked for examples but still at a loss as a novice.

I tried "wdParagraph" instead of "wdLine" but couldn't get that to work.

Located refs of maybe using a "paragraph.range.select" and also found a note that advised these "start" and "end" terms (below) to select a paragraph.. but not sure how to achieve this?
* Selection.StartOf Unit:=wdParagraphm
* Selection.MoveEnd Unit:=wdParagraph

Hoping someone has an example of how to accomplish this as it will help greatly with quickly identifying hundreds of software reqs out of a 100 page word doc.. so frustrated!
 

macropod

Microsoft MVP
Joined
Mar 2, 2012
Messages
580
Reaction score
50
Try:

Code:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "Contractor Shall"
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindStop
  .Format = True
  .MatchWildcards = True
  .Execute
  End With
  Do While .Find.Found
  .Duplicate.Paragraphs.First.Range.HighlightColorIndex = wdYellow
  .Start = .Duplicate.Paragraphs.First.Range.End
  .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub
 
Joined
Sep 8, 2016
Messages
12
Reaction score
1
Try:

Code:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "Contractor Shall"
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindStop
  .Format = True
  .MatchWildcards = True
  .Execute
  End With
  Do While .Find.Found
  .Duplicate.Paragraphs.First.Range.HighlightColorIndex = wdYellow
  .Start = .Duplicate.Paragraphs.First.Range.End
  .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub
========================================================
Thank you Macropod for the post..
I pasted it into a new module and hit run but it performed no yellow highlighting within the document??
And the code listed in the cross-post by the other person did not highlight through to the end of paragraph so I'm still looking for something that works. Is there something I'm missing in the code you posted that I need to edit in some way? I even tried stepping through it with/ F8 - but nothing...
 

macropod

Microsoft MVP
Joined
Mar 2, 2012
Messages
580
Reaction score
50
The code works fine for what you specified - 'Contractor Shall'. Using wildcards, makes the Find/Replace case-sensitive. If that's not what you want, change '.MatchWildcards = True' to '.MatchWildcards = False'.
 
Joined
Sep 8, 2016
Messages
12
Reaction score
1
Thank you, I tested the above again and no highlighting occurred at all - which is odd because it seems like it would have picked up at least one hit where the case sensitivity was applicable - but nothing turned yellow.
I edited the MatchWildcards to FALSE and everything that needed highlighted WAS INDEED highlighted!
CHEERS!

I've also another chunk of code to offer that uses a different method but works the same way. Hoping the 2 methods will help other newbies like me who are still learning each day! Thanks again for your help! GREATLY appreciated!

Method 1 Code (MatchWildcards=False):
Code:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "Contractor Shall"
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindStop
  .Format = True
  .MatchWildcards = False
  .Execute
  End With
  Do While .Find.Found
  .Duplicate.Paragraphs.First.Range.HighlightColorIndex = wdYellow
  .Start = .Duplicate.Paragraphs.First.Range.End
  .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub


Method 2 Code (Alternative):

Code:
Sub Highlight_Paragraph()
  Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
  Do While .Execute(FindText:="Contractor Shall")
  oRng.Paragraphs(1).Range.HighlightColorIndex = wdYellow
  oRng.Collapse 0
  Loop
  End With
  lbl_Exit:
  Set oRng = Nothing
  Exit Sub
  End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top