Help, How to do a Find in a Table, then Shade color?

gmayor · #9 01-09-2022, 10:37 PM

Adding the document to your original message rather than your latest message caused a momentary confusion, but based on that document the following will work

Code:

Sub Macro1()
Dim oTable As Table
Dim oCell As Cell
Dim oRng As Range
    For Each oTable In ActiveDocument.Tables
        For Each oCell In oTable.Range.Cells
            Set oRng = oCell.Range
            With oRng.Find
                Do While .Execute(findText:="&")
                    If oRng.Font.Bold = True Then
                        If oRng.Font.ColorIndex = wdRed Or _
                           oRng.Font.ColorIndex = wdGreen Then
                            oRng.HighlightColorIndex = wdYellow
                            oCell.Shading.BackgroundPatternColor = &HD9E9FD
                        End If
                    End If
                    Exit Do
                Loop
            End With
        Next oCell
    Next oTable
    Set oTable = Nothing
     Set oCell = Nothing
    Set oRng = Nothing

 End Sub

I noted that one of the ampersands in the last row of the tables was not coloured red so that one is not processed. If you only want to process cells with bold ampersands regardless of colour, then remove the colour check e.g.

Code:

Sub Macro1()
Dim oTable As Table
Dim oCell As Cell
Dim oRng As Range
    For Each oTable In ActiveDocument.Tables
        For Each oCell In oTable.Range.Cells
            Set oRng = oCell.Range
            With oRng.Find
                Do While .Execute(findText:="&")
                    If oRng.Font.Bold = True Then
                        oRng.HighlightColorIndex = wdYellow
                        oCell.Shading.BackgroundPatternColor = &HD9E9FD
                    End If
                    Exit Do
                Loop
            End With
        Next oCell
    Next oTable
    Set oTable = Nothing
    Set oCell = Nothing
    Set oRng = Nothing

 End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Conditionally Shade Table Cells	S7ewie	Mail Merge	8	04-29-2021 01:52 AM
Macro to change an RGB table cell shading color to another RGB color	David Matthews	Word VBA	4	05-29-2018 02:45 PM
Code to find a named (bookmarked?) table, replicate a row or table, and delete a specified table.	kevinbradley57	Word VBA	9	09-21-2017 04:58 PM
Text area in table won't shade	LSHAW	Word Tables	1	03-09-2017 03:08 PM
VBA Table – Search All Tables - Find & Replace Text in Table Cell With Specific Background Color	jc491	Word VBA	8	09-30-2015 06:10 AM