Search the TextFrameStory ranges.

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.StoryRanges(wdTextFrameStory)
    Do
      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
      Set oRng = oRng.NextStoryRange
    Loop Until oRng Is Nothing
  Next lngIndex
lbl_Exit:
  Exit Sub
End Sub