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. :devil2:

[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 :D

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.