Highlight Whole Paragraph Containing Specific Text

[VB-AN-IZ]

So, I've plagiarized this code:
http://www.msofficeforums.com/word-v...html#post48397

It highlights any text between:

Split("

", ",")

...as long as there are no spaces between each comma.

Sub ListChange()
Dim r As Range
Dim MyList() As String
Dim i As Long
MyList = Split("dot,com,like", ",")
For i = 0 To UBound(MyList())
   Set r = ActiveDocument.Range
      With r.Find
         .Text = MyList(i)
         .Replacement.Highlight = wdYellow
         .Execute Replace:=wdReplaceAll
      End With
Next
End Sub

Is there a way to modify this code – or, I guess, create an entirely new one – which highlights the entire paragraph containing specific text?

For example, in this text:

You can do anything, but not everything.
Perfection is achieved, not when there is nothing more to add, but when there is nothing left to take away.
The richest man is not he who has the most, but he who needs the least.
You miss 100% of the shots you never take.

...could I search for the text "richest" and highlight the entire third paragraph?

I really have no idea how to specify "up to last and next paragraph" without getting into trouble...

Thanks for any help!

[macropod]

Try something along the lines of:

Sub ListChange()
    Dim r As Range
    Dim MyList() As String
    Dim i As Long
    MyList = Split("dot,com,like", ",")
    For i = 0 To UBound(MyList())
        Set r = ActiveDocument.Range
        With r.Find
            .Text = "[!^13]@" & MyList(i) & "*^13"
            .Replacement.Highlight = wdYellow
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
    Next
End Sub

This should work for any paragraph where the find expression is not the first word in the paragraph. Note that the code is also now case-sensitive. More complicated code would be required to remove case-sensitivity and to handle first-words.

[mana]

Option Explicit


Sub test()
    Dim r As Range
    Dim s As String
    
    s = "richest"


    Set r = ActiveDocument.Range
    
    With r.Find
        .Text = s
        Do While .Execute
            r.Paragraphs(1).Range.HighlightColorIndex = wdYellow
        Loop
    End With


End Sub

[VB-AN-IZ]

Excellent. Thank you.

Is there a more efficient way to highlight several at once ("richest" and "perfection") than this?

Sub test()
    
    Dim r As Range
    Dim s As String
     
    s = "richest"
          
    Set r = ActiveDocument.Range
     
    With r.Find
        .Text = s
        Do While .Execute
            r.Paragraphs(1).Range.HighlightColorIndex = wdYellow
        Loop
    End With
     
    s = "perfection"
          
    Set r = ActiveDocument.Range
     
    With r.Find
        .Text = s
        Do While .Execute
            r.Paragraphs(1).Range.HighlightColorIndex = wdYellow
        Loop
    End With
     
End Sub

[mana]

Option Explicit


Sub test2()
    Dim r As Range
    Dim s
   
    For Each s In Array("richest", "perfection")
        Set r = ActiveDocument.Range
        With r.Find
            .Text = s
            .Highlight = False
            Do While .Execute
                r.Paragraphs(1).Range.HighlightColorIndex = wdYellow
            Loop
        End With
    Next


End Sub

[VB-AN-IZ]

Ahhhh. That answers my next follow-up question as well. Excellent.

Works brilliantly. Thanks very much!

[mana]

Is there a more efficient way to highlight several at once ("richest" and "perfection") than this?

Did you try macropod's #2 ?

[macropod]

You could try:

Sub ListChange() 
    Application.ScreenUpdating = False
    Dim MyList() As String, i As Long 
    MyList = Split("dot,com,like", ",")
    With ActiveDocument.Range.Find  
        .Replacement.Highlight = wdYellow 
        .MatchWildcards = True
        For i = 0 To UBound(MyList()) 
            .Text = "[!^13]@" & MyList(i) & "*^13" 
            .Execute Replace:=wdReplaceAll 
            .Text = "[!^13]" & MyList(i) & "*^13" 
            .Execute Replace:=wdReplaceAll 
        Next 
    End With  
    Application.ScreenUpdating = True
End Sub

With many instances to process this would be far faster than the code in post #5, for example.