Solved: Change cell shading based on content control

[brent.fraser]

I'm working on an interactive form where the colour of the cell that contains a content control (drop down list) gets shaded depending on the value the user selects (which is working well). I have about 40 of the drop down cc's in the document and that's where the issue lies. If I only have one cc, everything works fine. I have copied and pasted the cc in the attached document 4 times (for a total of 5 drop downs). I am assuming that since I have the same cc in 5 areas, that's where the issue comes into play.

The code I have is as follows:

Sub ColourCells()
Dim instance As WdColor
Dim oTbl As Table
Dim oCel As Cell
Dim oRng As Range
Dim oCC_rating As ContentControl
Set oCC_rating = ActiveDocument.SelectContentControlsByTag("rating").Item(1)
For Each oTbl In ActiveDocument.Tables
For Each oCel In oTbl.Range.Cells
Set oRng = oCel.Range
oRng.End = oRng.End - 1
Select Case oRng.Text
Case "Unsatisfactory"
If oCC_rating.Range.Text = "Unsatisfactory" Then
oCel.Shading.BackgroundPatternColor = wdColorRed
oCel.Range.Font.Color = wdColorWhite
End If
Case "Improvement Needed"
If oCC_rating.Range.Text = "Improvement Needed" Then
oCel.Shading.BackgroundPatternColor = wdColorOrange
oCel.Range.Font.Color = wdColorBlack
End If
Case "Meets Expectations"
If oCC_rating.Range.Text = "Meets Expectations" Then
oCel.Shading.BackgroundPatternColor = wdColorYellow
oCel.Range.Font.Color = wdColorBlack
End If
Case "Exceeds Expectations"
If oCC_rating.Range.Text = "Exceeds Expectations" Then
oCel.Shading.BackgroundPatternColor = wdColorGreen
oCel.Range.Font.Color = wdColorWhite
End If
Case "Exceptional"
If oCC_rating.Range.Text = "Exceptional" Then
oCel.Shading.BackgroundPatternColor = RGB(0, 102, 0)
oCel.Range.Font.Color = wdColorWhite
End If
Case "Choose an item."
If oCC_rating.Range.Text = "Choose an item." Then
oCel.Shading.BackgroundPatternColor = wdColorWhite
oCel.Range.Font.Color = wdColorGray50
End If
End Select
Next
Next
End Sub

As you can see, I have named/tagged the cc "rating."

Since I will have about 40 of the cc's, I don't necessarily want to name each one individually and copy, paste and modify the above code 40 times (I will if I have to).

Since the behavior for each cc is exactly the same, is there a way to apply the code to all the cc's at once without having to do it multiple times?

Cheers everyone.

B.

[gmaxey]

Brent,

I'm not certain I understand what it is that you want to do, but what you are doing can be simplified:

Sub ColourCellsII()
Dim instance As WdColor
Dim oCC As ContentControl
For Each oCC In ActiveDocument.ContentControls
If oCC.Title = "rating" Then
Select Case oCC.Range.Text
Case "Unsatisfactory"
oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorRed
oCC.Range.Cells(1).Range.Font.Color = wdColorWhite
Case "Improvement Needed"
oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorOrange
oCC.Range.Cells(1).Range.Font.Color = wdColorBlack
Case "Meets Expectations"
oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorYellow
oCC.Range.Cells(1).Range.Font.Color = wdColorBlack
Case "Exceeds Expectations"
oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorGreen
oCC.Range.Cells(1).Range.Font.Color = wdColorWhite
Case "Exceptional"
oCC.Range.Cells(1).Shading.BackgroundPatternColor = RGB(0, 102, 0)
oCC.Range.Cells(1).Range.Font.Color = wdColorWhite
Case "Choose an item."
oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorWhite
oCC.Range.Cells(1).Range.Font.Color = wdColorGray50
End Select
End If
Next
End Sub

[brent.fraser]

Once again, you did it.

It's exactly what I needed. Thanks for the help again! It's a pretty kick-butt form thanks to your help!

Have a good one Mr. M!