Microsoft Office Forums - View Single Post - How to run colour conditional formatting in just column, not whole table

gmayor · 09-11-2019, 11:03 PM

Assuming that your table does not have merged or split cells and there is a header row, then the following macro will look for the column header 'Score' (change as appropriate) then will use your process to format only that column:

Code:

Sub Macro1()
Dim oTable As Table
Dim c As Word.Cell
Dim iCol As Integer
Set oTable = Selection.Tables(1)    'or ActiveDocument.Tables(1)
    For iCol = 1 To oTable.Columns.Count
        If InStr(1, oTable.Rows(1).Cells(iCol), "Score") > 0 Then
            For Each c In oTable.Range.Columns(iCol).Cells
                If IsNumeric(Left(c.Range.Text, Len(c.Range.Text) - 1)) Then
                    If Val(c.Range.Text) = 1 Then
                        c.Shading.BackgroundPatternColor = 10669990
                    ElseIf Val(c.Range.Text) = 2 Then
                        c.Shading.BackgroundPatternColor = 12443072
                    ElseIf Val(c.Range.Text) = 3 Then
                        c.Shading.BackgroundPatternColor = 10546144
                    ElseIf Val(c.Range.Text) = 4 Then
                        c.Shading.BackgroundPatternColor = 12512766
                    ElseIf Val(c.Range.Text) = 5 Then
                        c.Shading.BackgroundPatternColor = 12440539
                    ElseIf Val(c.Range.Text) = 6 Then
                        c.Shading.BackgroundPatternColor = 9813759
                    ElseIf Val(c.Range.Text) = 7 Then
                        c.Shading.BackgroundPatternColor = 12233699
                    ElseIf Val(c.Range.Text) = 8 Then
                        c.Shading.BackgroundPatternColor = 12830711
                    ElseIf Val(c.Range.Text) = 9 Then
                        c.Shading.BackgroundPatternColor = 12830711
                    ElseIf Val(c.Range.Text) < 9 Then
                        c.Shading.BackgroundPatternColor = wdColorWhite

                    Else
                        c.Shading.BackgroundPatternColor = wdColorWhite
                    End If
                Else    ' set non-numeric to White
                    c.Shading.BackgroundPatternColor = wdColorWhite
                End If
            Next c
        End If
    Next iCol
    Set oTable = Nothing
    Set c = Nothing
End Sub