Color table cell based on string

[gmaxey]

Well the code I sent is looking for "some text" To look for four different strings and using four different colors, you would need a loop:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
Dim oTbl As Table
Dim arrTerm() As String
Dim arrCI(3) As Long
Dim lngIndex As Long
  arrTerm = Split("Rarely,Sometimes,Often,Consistently", ",")
  arrCI(0) = wdColorRed: arrCI(1) = wdColorOrange: arrCI(2) = wdColorYellow: arrCI(3) = wdColorGreen
  For lngIndex = 0 To UBound(arrTerm)
    Set oRng = ActiveDocument.Range
    With oRng.Find
      .Text = arrTerm(lngIndex)
      While .Execute
        Set oTbl = Nothing
        On Error Resume Next
        Set oTbl = oRng.Tables(1)
        If Not oTbl Is Nothing Then
          oRng.Cells(1).Shading.BackgroundPatternColor = arrCI(lngIndex)
          oRng.Collapse wdCollapseEnd
        End If
      Wend
    End With
  Next lngIndex
lbl_Exit:
  Exit Sub
End Sub