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