Sub TblHiLite()
Application.ScreenUpdating = False
Dim Hdr As Long, S As Long, W As Long, C As Long, R As Long, H As Long, i As Long
Dim StrTitle As String, StrParms As String, StrRGB As String
'Abort if the cursor is not in a table
If Selection.Information(wdWithInTable) = False Then
  MsgBox "The selection is not in a table!", vbOKOnly, "TblHiLite"
  GoTo ErrExit
End If
'Get Parameters
On Error GoTo ErrExit
StrParms = Split(Selection.Tables(1).Range.Previous.Paragraphs.Last.Range.Text, vbCr)(0)
For i = 0 To UBound(Split(StrParms, "="))
  Select Case i
    i = 0: C = Trim(Split(Split(StrParms, "=")(1), ",")(0))
    i = 1: StrRGB = Trim(Split(Split(StrParms, "=")(2), ",")(0))
    i = 2: Hdr = Trim(Split(StrParms, "=")(3))
  End Select
Next
S = RGB(Split(StrRGB, ",")(0), Split(StrRGB, ",")(1), Split(StrRGB, ",")(2))
On Error GoTo 0
W = RGB(255, 255, 255)
'process the table
With Selection.Tables(1)
  'Validate the column count
  If C > .Columns.Count Then
    MsgBox "There is no column " & C & " in the table!", vbOKOnly, "TblHiLite"
    End
  End If
  'Validate the heading row count
  If Hdr = 0 Then
    For i = 1 To .Rows.Count
      If .Rows(i).HeadingFormat = True Then
        Hdr = Hdr + 1
      Else
        Exit For
      End If
    Next
  ElseIf Hdr > .Rows.Count Then
    MsgBox "There is no row " & Hdr & " in the table!", vbOKOnly, "TblHiLite"
    End
  End If
  StrTitle = Split(.Cell(1 + Hdr, C).Range.Text, vbCr)(0)
  .Rows(1 + Hdr).Shading.BackgroundPatternColor = W: H = W
  For R = 2 + Hdr To .Rows.Count
    If Split(.Cell(R, C).Range.Text, vbCr)(0) <> StrTitle Then
      If H = W Then H = S Else H = W
      StrTitle = Split(.Cell(R, C).Range.Text, vbCr)(0)
    End If
    .Rows(R).Shading.BackgroundPatternColor = H
  Next
End With
Application.ScreenUpdating = True
End
ErrExit:
MsgBox "Invalid Parameter", vbExclamation
End Sub