CODEWITHSUNDEEP
vbams-word
Jim68Flem
Jim68Flem

Reputation: 15

Using a macro to conditional format a specific column in Word Table

I have a macro that changes the background colour of a table in Word depending upon the text within the same cell - akin to Excel's conditional formatting rules.

However I want to restrict this to a specific column - column 2 in a table of many rows but two columns: column 1 being where the question is and column 2 is where the user inputs the answer from a dropdown list - and depending upon the answer the cell changes colour.

My code is below; but this is applying it to both columns.

Anyone know how to re-code so it only applies to table column 2. I am using MS Word 2016.

Thanks

Dim r As Range

Sub UBC ()
    color "No", wdRed
    color "Yes", wdGreen
    color "Unknown", wdYellow
    color "Not Applicable", wdGray50
End Sub

Function color(text As String, backgroundColor As WdColorIndex)
    Set r = ActiveDocument.Range

    With r.Find
       Do While .Execute(FindText:=text, MatchWholeWord:=True, Forward:=True) = True
    r.Cells(1).Shading.BackgroundPatternColorIndex = backgroundColor
       Loop
    End With
End Function

Upvotes: 0

Views: 2364

Answers (2)

Dick Kusleika
Dick Kusleika

Reputation: 33145

You could use the Exit event of the ContentControl. When the user moves out of the cell, it's formatted based on what was selected. This code goes in the ThisDocument module.

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)

    Select Case ContentControl.Range.Text
        Case "Yes"
            ContentControl.Range.Cells(1).Shading.BackgroundPatternColorIndex = wdGreen
        Case "No"
            ContentControl.Range.Cells(1).Shading.BackgroundPatternColorIndex = wdRed
        Case "Unknown"
            ContentControl.Range.Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
        Case "Not Applicable"
            ContentControl.Range.Cells(1).Shading.BackgroundPatternColorIndex = wdGray50
    End Select

End Sub

If you're using legacy dropdowns as form fields, you can put this sub as the Exit Macro. You'll have to complete the macro for all the options.

Public Sub LegacyDropDownExit()

    ThisDocument.Unprotect

    Select Case Selection.FormFields(1).Result
        Case "Yes"
            Selection.Cells(1).Range.Shading.BackgroundPatternColorIndex = wdGreen
        Case "No"
            Selection.Cells(1).Range.Shading.BackgroundPatternColorIndex = wdRed
    End Select

    ThisDocument.Protect wdAllowOnlyFormFields, True

End Sub

If you're using ActiveX controls, you can do something like this

Private Sub ComboBox1_Change()

    ChangeCellBg Me.ComboBox1.Value, 1

End Sub

Private Sub ComboBox2_Change()

    ChangeCellBg Me.ComboBox2.Value, 2

End Sub

Private Sub ComboBox3_Change()

    ChangeCellBg Me.ComboBox3.Value, 3

End Sub

Private Sub ChangeCellBg(ByVal sValue As String, ByVal lRow As Long)

    Select Case sValue
        Case "Yes"
            Me.Tables(1).Cell(lRow, 2).Range.Shading.BackgroundPatternColorIndex = wdGreen
        Case "No"
            Me.Tables(1).Cell(lRow, 2).Range.Shading.BackgroundPatternColorIndex = wdRed
    End Select

End Sub

You can also create a class module so you don't have to create all those Change events, but that's beyond the scope of this answer.

Upvotes: 0

Cindy Meister
Cindy Meister

Reputation: 25663

Building on the Answer that was given to you yesterday...

Once the If has checked whether the found Range is in a table, it's possible to conditionally check in which column the Range's cell is located:

Function color(text As String, backgroundColor As WdColorIndex)
    Dim r As Word.Range

    Set r = ActiveDocument.content

    With r.Find
       Do While .Execute(findText:=text, MatchWholeWord:=True, Forward:=True) = True
          If r.Tables.Count > 0 Then
            If r.Cells(1).ColumnIndex = 2 Then
                r.Cells(1).Shading.BackgroundPatternColorIndex = backgroundColor
            End If
          End If
       Loop
    End With
End Function

Upvotes: 1

Related Questions