Change background colour of column of word table when text is PH using a macro

Question

I am having trouble in developing a macro to look through a word document and change the background colour columns in a table.

The macro needs to look at each table in the word document, and if a cell has the text 'PH' then the column of that cell needs to change the background colour.

It's been a while since I used VB. I've tried cell.range too as well as Selection.Find below but just keep getting errors.

Private Sub Document_Open()

Dim Tbl As Table
Dim Cel As Cell
Dim Rw As Row
Dim Col As Columns

For Each Tbl In ActiveDocument.Tables
  Set Col = Tbl.Columns
  For Each c In Col

    With Selection.Find
     .Execute FindText:="Public Holiday"
     c.Shading.BackgroundPatternColorIndex = wdRed
    End With   
  Next
Next

End Sub

Answer 1

Tested

Dim Tbl As Table
Dim i As Integer, j As Integer

For Each Tbl In ActiveDocument.Tables

    For j = 1 To Tbl.Columns.Count

        For i = 1 To Tbl.Rows.Count

            If InStr(1, Tbl.Cell(i, j).Range.Text, "PH") Then Tbl.Columns(j).Shading.BackgroundPatternColor = -738132122

        Next

    Next

Next

Looping through each cell and checking if it contains "PH", if yes then colouring that column.

Answer 2

The following works for me and is somewhat faster than looping the tables and table cells.

Instead, it searches the entire document for PH, then checks whether the found area is within a table. If it is, then the column is formatted. The search then begins again from the next cell. Note that I've set this code to "match case" so that it only picks up PH, not ph or any other variation. Otherwise, it would end up recognizing words such as telephone...

Working with table columns is often tricky because a table column may look like it's continuous, but it's not. Only rows are continuous (Word parses from left to right, top to bottom). So it's not really possible to search column to column unless the columns are selected, one after the other. Which is the other issue with the code in the question: it uses Selection, but the selection is not changed to what should be searched.

Private Sub Document_Open()
    Dim rngFind As Word.Range
    Dim found As Boolean

    Set rngFind = ActiveDocument.content
    With rngFind.Find
        .ClearFormatting
        .Wrap = wdFindStop
        .Text = "PH"
        .MatchCase = True
        found = .Execute
        Do
            If found Then
                If rngFind.Information(wdWithInTable) Then
                    rngFind.Columns(1).Shading.BackgroundPatternColorIndex = wdRed
                    rngFind.MoveStart wdCell, 1
                Else
                    rngFind.Collapse wdCollapseEnd
                End If
            End If
            found = .Execute
        Loop While found
    End With
End Sub