Dim vFindText, vReplText As String
Dim vColor As String
Dim x As Integer
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
For x = 1 To 3
  Select Case x
    Case Is = 1
      vFindText = "Cat I"
      vColor = wdRed
    Case Is = 2
      vFindText = "Cat II"
      vColor = wdYellow
    Case Is = 3
      vFindText = "Cat III"
      vColor = wdPink
  End Select
  vReplText = vFindText
  With Selection.Find
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Format = True
    .MatchCase = False
    .Text = vFindText
    .Replacement.Text = vReplText
    .Replacement.Highlight = True
    .Execute Replace:=wdReplaceAll
    .Font.Color = vColor
  End With
Next x

Sub Demo()
Application.ScreenUpdating = False
Dim vFindText As String, vColor As String, x As Long
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Wrap = wdFindContinue
  .Format = False
  .MatchWildcards = True
  'Insert Page breaks before the paragraphs preceding the 'Cat #' paragraphs
  .Text = "[!^13]{1,}^13Cat I"
  .Replacement.Text = "^m^&"
  .Execute Replace:=wdReplaceAll
  'Delete any duplicate page breaks
  .Text = "[^m]{2,}"
  .Replacement.Text = "^m"
  .Execute Replace:=wdReplaceAll
  'Highlight the 'Cat #' paragraphs
  .Replacement.Text = "^&"
  .Replacement.Highlight = True
  For x = 1 To 3
    Select Case x
      Case Is = 1
        vFindText = "Cat I^13"
        vColor = wdRed
      Case Is = 2
        vFindText = "Cat II^13"
        vColor = wdYellow
      Case Is = 3
        vFindText = "Cat III^13"
        vColor = wdPink
    End Select
    Options.DefaultHighlightColorIndex = vColor
    .Text = vFindText
    .Execute Replace:=wdReplaceAll
  Next x
  Options.DefaultHighlightColorIndex = wdNoHighlight
End With
Application.ScreenUpdating = True
End Sub