Your code's main Select Case statement is all wrong. You shouldn't have all those:
End Select
Select Case .Title
line pairs. You could also re-code the sub so the protection is processed only once. Similarly, where you don't change the font attributes for a given dropdown, there's no point having:
.Font.ColorIndex = wdAuto
for any of them, let alone all. You have again 'created' your own BackgroundPatternColorIndex - there is no such thing as 'Red'; it's wdRed. Basic coding errors of this kind would be trapped if you added:
Option Explicit
to the top of the code module.
The problems with "Unsatisfactory" and "Adequate" are most likely because what you're testing is not
exactly the same as the dropdown selection. I also can't see the point of having BackgroundPatternColorIndex for your "Schedule", "GM" & "Cash" cases, as they effectively all produce the same output.
As for the document being 'frozen', your code applies 'filling in forms' protection once one of the designated content controls is exited, regardless of whether that protection was applied beforehand. The freezing might also result from the code hanging due to such simple errors as 'Red'.
Try the following:
Code:
Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
Dim bProt As Long: Const StrPwd As String = "abc"
With CCtrl
If (.Title <> "Finding") And (.Title <> "Finding") And (.Title <> "Schedule") And (.Title <> "GM") And (.Title <> "Cash") Then Exit Sub
With ActiveDocument
bProt = .ProtectionType
If bProt <> wdNoProtection Then .Unprotect Password:=StrPwd
End With
Select Case .Title
Case "Finding"
With .Range
Select Case .Text
Case "A"
.Cells(1).Shading.BackgroundPatternColorIndex = wdRed
Case "B"
.Cells(1).Shading.BackgroundPatternColor = RGB(255, 153, 0)
Case "C"
.Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
Case Else
.Cells(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
End Select
End With
Case "Rating"
With .Range
Select Case .Text
Case "Satisfactory"
.Cells(1).Shading.BackgroundPatternColorIndex = wdBrightGreen
Case "Adequate"
.Cells(1).Shading.BackgroundPatternColorIndex = wdBrightYellow
Case "Requires Improvement"
.Cells(1).Shading.BackgroundPatternColor = RGB(255, 153, 0)
Case "Unsatisfactory"
.Cells(1).Shading.BackgroundPatternColorIndex = wdRed
Case Else
.Cells(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
End Select
End With
Case "Schedule"
With .Range
Select Case .Text
Case "No"
.Font.ColorIndex = wdRed
Case Else
.Font.ColorIndex = wdAuto
End Select
End With
Case "GM"
With .Range
Select Case .Text
Case "Lower than ORA"
.Font.ColorIndex = wdRed
Case Else
.Font.ColorIndex = wdAuto
End Select
End With
Case "Cash"
With .Range
Select Case .Text
Case "Negative"
.Font.ColorIndex = wdRed
Case Else
.Font.ColorIndex = wdAuto
End Select
End With
End Select
End With
If bProt <> wdNoProtection Then ActiveDocument.Protect bProt, True, StrPwd
End Sub