How to highlight whole row of table when specific text is found in cell?

[mmarc30]

Let's say I have the following table:
How can I tell Word so that when it finds "Donuts ()", it needs highlight the entire row yellow?

test	Donuts ()	blah blah	blahblah
test2	Pancakes ()	yada yada	more columns
test3	Pancakes ()	more test	more test

Also, is it possible to tell word to search and replace for words with a counter?
For instance, I want to replace the two "Pancakes ()" with "Pancakes (1)" and "Pancakes (2)", and so on.

[gmayor]

The following will do as your request

Option Explicit

Sub ExampleMacro()
'Graham Mayor - http://www.gmayor.com
Dim oTable As Table
Dim oRng As Range
Dim i As Integer
    Set oTable = ActiveDocument.Tables(1)
    Set oRng = oTable.Range
    With oRng.Find
        Do While .Execute(FindText:="Donuts")
            If oRng.InRange(oTable.Range) Then
                oRng.Rows(1).Range.Shading.BackgroundPatternColor = wdColorTurquoise
            End If
            oRng.Collapse 0
        Loop
    End With
    Set oRng = oTable.Range
    i = 1
    With oRng.Find
        Do While .Execute(FindText:="Pancakes ()")
            If oRng.InRange(oTable.Range) Then
                oRng.Text = "Pancakes (" & i & ")"
                i = i + 1
            End If
            oRng.Collapse 0
        Loop
    End With
lbl_Exit:
    Set oTable = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

[gmaxey]

Taking Graham's code a step further, you can define multiple terms in an array and process the array:

Sub ExampleMacro()
Dim oTbl As Word.Table
Dim oRng As Range
Dim lngIndex As Long, lngCount As Long
Dim arrTerms() As String
  arrTerms = Split("Donuts(),Pancakes()", ",")
  Set oTbl = ActiveDocument.Tables(1)
  For lngIndex = 0 To UBound(arrTerms)
    Set oRng = oTbl.Range
    lngCount = 1
    With oRng.Find
      Do While .Execute(FindText:=arrTerms(lngIndex))
        If oRng.InRange(oTbl.Range) Then
          oRng.Rows(1).Range.Shading.BackgroundPatternColor = wdColorTurquoise
          oRng.Text = Replace(oRng.Text, "()", "(" & lngCount & ")")
          lngCount = lngCount + 1
        End If
        oRng.Collapse 0
      Loop
    End With
  Next
lbl_Exit:
  Set oTbl = Nothing
  Set oRng = Nothing
  Exit Sub
End Sub

[gmayor]

Greg, I was waiting with that one for when our friend came back with the goalposts moved.

[gmaxey]

What! Someone might move a goalpost? Never!

[mmarc30]

Thanks guys!

[gmaxey]

You're welcome. By your post count you are, at least here, a true newbie to VBA. While Graham, I and others will often just hand you a fish, the idea is for you to learn to catch your own fish. Use the macro recorder or just post something to show that you are trying to learn.

[mmarc30]

Oh yes, I took a lot from both of your codes and came up with a solution that can scan for different words, and highlight with multiple words.

Option ExplicitSub ExampleMacro()
    Dim oTbl As Table
    Dim oRng As Range
    Set oTbl = ActiveDocument.Tables(3)
    Dim lngIndex As Long, lngIndex2 As Long, lngIndex3 As Long, lngIndex4 As Long, lngIndex5 As Long, lngCount As Long, lngCount2 As Long, lngCount3 As Long, lngCount4 As Long, lngCount5 As Long
    Dim arrTerms() As String
    Dim arrTerms2() As String
    Dim arrTerms3() As String
    Dim arrTerms4() As String
    Dim arrTerms5() As String
    arrTerms = Split("Pancakes (),Pancakes,Information,Started,Concluded", ",")
    arrTerms2 = Split("Waffles (),Waffles", ",")
    arrTerms3 = Split("Oranges (),Oranges", ",")
    arrTerms4 = Split("Blueberries (),Blueberries", ",")
    arrTerms5 = Split("Pineapples (),Pineapples", ",")
    For lngIndex = 0 To UBound(arrTerms)
        Set oRng = oTbl.Range
        lngCount = 1
        With oRng.Find
            Do While .Execute(FindText:=arrTerms(lngIndex))
                If oRng.InRange(oTbl.Range) Then
                    oRng.Rows(1).Range.Shading.BackgroundPatternColor = wdColorYellow
                    oRng.Text = Replace(oRng.Text, "()", "(" & lngCount & ")")
                    lngCount = lngCount + 1
                End If
                oRng.Collapse 0
            Loop
        End With
    Next
    For lngIndex2 = 0 To UBound(arrTerms2)
        Set oRng = oTbl.Range
        lngCount2 = 1
        With oRng.Find
            Do While .Execute(FindText:=arrTerms2(lngIndex2))
                If oRng.InRange(oTbl.Range) Then
                    oRng.Rows(1).Range.Shading.Texture = wdTextureNone
                    oRng.Rows(1).Range.Shading.ForegroundPatternColor = wdColorAutomatic
                    oRng.Rows(1).Range.Shading.BackgroundPatternColor = 12611584
                    oRng.Text = Replace(oRng.Text, "()", "(" & lngCount2 & ")")
                    lngCount2 = lngCount2 + 1
                End If
                oRng.Collapse 0
            Loop
        End With
    Next
    For lngIndex3 = 0 To UBound(arrTerms3)
        Set oRng = oTbl.Range
        lngCount3 = 1
        With oRng.Find
            Do While .Execute(FindText:=arrTerms3(lngIndex3))
                If oRng.InRange(oTbl.Range) Then
                    oRng.Rows(1).Range.Shading.Texture = wdTextureNone
                    oRng.Rows(1).Range.Shading.ForegroundPatternColor = wdColorAutomatic
                    oRng.Rows(1).Range.Shading.BackgroundPatternColor = 49407
                    oRng.Text = Replace(oRng.Text, "()", "(" & lngCount3 & ")")
                    lngCount3 = lngCount3 + 1
                End If
                oRng.Collapse 0
            Loop
        End With
    Next
    For lngIndex4 = 0 To UBound(arrTerms4)
        Set oRng = oTbl.Range
        lngCount4 = 1
        With oRng.Find
            Do While .Execute(FindText:=arrTerms4(lngIndex4))
                If oRng.InRange(oTbl.Range) Then
                    oRng.Rows(1).Range.Shading.Texture = wdTextureNone
                    oRng.Rows(1).Range.Shading.ForegroundPatternColor = wdColorAutomatic
                    oRng.Rows(1).Range.Shading.BackgroundPatternColor = 15773696
                    oRng.Text = Replace(oRng.Text, "()", "(" & lngCount4 & ")")
                    lngCount4 = lngCount4 + 1
                End If
                oRng.Collapse 0
            Loop
        End With
    Next
    For lngIndex5 = 0 To UBound(arrTerms5)
        Set oRng = oTbl.Range
        lngCount5 = 1
        With oRng.Find
            Do While .Execute(FindText:=arrTerms5(lngIndex5))
                If oRng.InRange(oTbl.Range) Then
                    oRng.Rows(1).Range.Shading.Texture = wdTextureNone
                    oRng.Rows(1).Range.Shading.ForegroundPatternColor = wdColorAutomatic
                    oRng.Rows(1).Range.Shading.BackgroundPatternColor = 5296274
                    oRng.Text = Replace(oRng.Text, "()", "(" & lngCount5 & ")")
                    lngCount5 = lngCount5 + 1
                End If
                oRng.Collapse 0
            Loop
        End With
    Next
    
lbl_Exit:
    Set oTbl = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

The next things I would like to do with this code is to implement a counter, so that the count doesn't start over from 0 everytime the code is run.
Let's say I have this after running the code:
Pancakes (1)
Pancakes (2)
If I add another one like so:
Pancakes (1)
Pancakes (2)
Pancakes ()
And run the code again, the count starts at one again, which gives me this:
Pancakes (1)
Pancakes (2)
Pancakes (1)
I have a table at the bottom of the word document, so I will try to do is modify it so that it shows
Col 1 Col2
Pancakes Current count
That way, I can set the starting counter to be that table's number, and things can be update dynamically

Although actually implementing will probably take a bit longer hehe.

[gmaxey]

I have no idea what you are trying to do with ("Pancakes,Pancakes (),Information,Started,Concluded) but something like this may suit your needs:

Sub ExampleMacro()
Dim oTbl As Table
Dim oRng As Range, oRngEval As Range
Set oTbl = ActiveDocument.Tables(3)
Dim lngIndex As Long, lngCount As Long
Dim arrComposite(4, 1) As Variant
  arrComposite(0, 0) = "Pancakes"
  arrComposite(0, 1) = 123546
  arrComposite(1, 0) = "Waffles"
  arrComposite(1, 1) = 12611584
  arrComposite(2, 0) = "Oranges"
  arrComposite(2, 1) = 49407
  arrComposite(3, 0) = "Blueberries"
  arrComposite(3, 1) = 1577369
  arrComposite(4, 0) = "Pineapples"
  arrComposite(4, 1) = 5296274
  For lngIndex = 0 To UBound(arrComposite)
    Set oRng = oTbl.Range
    lngCount = 1
    With oRng.Find
      Do While .Execute(FindText:=arrComposite(lngIndex, 0))
        If oRng.InRange(oTbl.Range) Then
          oRng.Rows(1).Range.Shading.BackgroundPatternColor = arrComposite(lngIndex, 1)
          Set oRngEval = oRng.Duplicate
          If oRngEval.Characters.Last.Next.Next = "(" Then
            oRngEval.Collapse wdCollapseEnd
            oRngEval.MoveEnd wdCharacter, 2
            Do While IsNumeric(oRngEval.Characters.Last.Next)
              oRngEval.MoveEnd wdCharacter, 1
            Loop
            If oRngEval.Characters.Last.Next = ")" Then oRngEval.MoveEnd wdCharacter, 1
            oRngEval.Delete
          End If
          oRng.Text = oRng.Text & " (" & lngCount & ")"
          lngCount = lngCount + 1
        End If
        oRng.Collapse 0
      Loop
    End With
  Next
lbl_Exit:
  Set oTbl = Nothing
  Set oRng = Nothing
  Exit Sub
End Sub

Note, this will number all items even if there is only one.