Another approach to your problem is to work with arrays instead of select case (Note: All 3 arrays must have the same number of elements).
The problem is that selecting a value from a drop down list (or the result of a formula) does not trigger an event that can be intercepted by Worksheet change event, so the code below will not work until you double click the cell and exit with enter (editing a cell is a Workbook_Change event) , AFTER you select from list....
You might reconsider your work steps, and run a slightly modified code from a button after selecting all the entries, or using the Before_Close event to run the code. Place this code under Sheet module, works for column 4 (D), under row 400 (change this in code as needed).
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SearchArr, FontColorArr, InteriorColorArr As Variant, i As Integer
If Target.Column = 4 And Target.Row < 400 Then
With ActiveCell.Offset(-1, 0)
SearchArr = Array("BLACK", "BLUE", "CADIAC ALERT", "GREEN", "GREY", "ICE ALERT", "ORANGE" _
, "PEDS CODE BLUE", "PINK", "PURPLE", "RAPID RESPONSE", "RED", "STEMI ALERT", "STROKE ALERT" _
, "WHITE", "YELLOW")
FontColorArr = Array("2", "2", "2", "1", "1", "1", "1", "1" _
, "2", "2", "1", "2", "2", "1", "1", "1")
InteriorColorArr = Array("1", "5", "30", "4", "16", "37", "46", "8" _
, "7", "13", "20", "3", "53", "22", "2", "6")
For i = LBound(SearchArr) To UBound(SearchArr)
If InStr(1, ActiveCell.Offset(-1, 0).Text, SearchArr(i), vbTextCompare) > 0 Then
ActiveCell.Offset(-1, 0).Interior.ColorIndex = InteriorColorArr(i)
ActiveCell.Offset(-1, 0).Font.ColorIndex = FontColorArr(i)
End If
Next i
End With
End If
End Sub