'===========================================================================
'                        Table Highlight Macro

' Written for Jigsaw Puzzle Log.
' Highlight alternate sections in light blue.
' Based on code from Macropod on MSOfficeForums.

'   Syntax: TblHiLite     'Assigned to Alt+Ctrl+Shift+h

'     To Do
' Add test for HumHdrs > number of rows.
' Add test for Column > number of columns.
' Add InputBoxes for column number, highlight colors, header row.

'     Change Log
'===========================================================================
Sub TblHiLite()

Const MyName As String = "TblHiLite"
'Abort if the cursor is not in a table
If Selection.Information(wdWithInTable) <> True Then
  MsgBox "The cursor is not in a table", vbOKOnly, MyName
  Exit Sub
End If

Dim HiLite1 As Long, HiLite2 As Long          'The two alternating highlight colors
Dim Blue As Long: Blue = RGB(219, 229, 241)   'Light blue
Dim White As Long: White = RGB(255, 255, 255) 'White = no highlighting
HiLite1 = White
HiLite2 = Blue

Application.ScreenUpdating = False
Dim Row As Long           'Row number (loop index)
Dim Column As Long        'The column number
Dim NumHdrs As Long       'The number of header rows
Dim HiLiteColor As Long   'The integer RGB value
Dim TgtTextNew As String  'The target text string
Dim TgtTextOld As String  'The previous target text string

HiLiteColor = HiLite2                 'Initialize the highlight color
Column = 1                            'Initialize the column number
NumHdrs = 1                           'Initialize the number of header rows
TgtTextOld = "!@#$%^&*()=+{}[]<>"     'In case first text string is blank
With Selection.Tables(1)              'Focus the selection on the table
  For Row = NumHdrs + 1 To .Rows.Count  'Loop through all row but the header
    TgtTextNew = Split(.Cell(Row, Column).Range.Text, vbCr)(0) 'Get next text string
    If TgtTextNew <> TgtTextOld Then      'If it's a new section
      TgtTextOld = TgtTextNew               'Save the text
                                            'Switch colors
      If HiLiteColor = HiLite1 Then         'If it's #1
        HiLiteColor = HiLite2                 'Switch to #2
      Else                                  'Else, it's #2
        HiLiteColor = HiLite1                 'So switch to #1
      End If
    End If
    .Rows(Row).Shading.BackgroundPatternColor = HiLiteColor 'Apply highlighting
  Next Row
End With
  
Application.ScreenUpdating = True

End Sub