Macro to highlight alternating sections of a table

Jennifer Murphy · #1 02-18-2020, 08:48 PM

I have a table of results for a collection of experiments. Each experiment has a title and may be run multiple times with different criteria. When I sort the table by the title, I like to highlight every other set of results with a light blue background. This helps be focus on the results for each experiment.

I did this manually once. But now I have added some new experiments that sort between existing experiments. Unless I redo the entire list, I will have two consecutive sets with the same highlighting (blue or none).

I would like to write a macro to redo the highlighting every time I add a new experiment, but my skills with Word VBA is not good enough.

Can someone give me the initial outline of a macro that will loop through each line (row) of a table, examine the title field, and change the highlighting whenever the title changes?

Here's a rough outline of what I think the macro needs to do. The code in parens is what I don't know how to do.

Code:

Sub TableHiLite()  'Not sure if it needs parameters

Dim HiLite as boolean
HiLite = True
Dim Row as Integer
Dim NumRows as Integer
 NumRows = (number of rows in the table)
Dim TitleNext as String
Dim TitlePrev as String

For Row = 2 to NumRows
  TitleNext = (title text in this row)
  If TitleNext <> TitlePrev then HiLite = Not HiLite
  If HiLite then (set the highlight for this row to light blue)
  Else (set the highlight for this row to light none)
Next Row

End Sub

Thanks

PS: Ooops. I just realized that this should have gone into the VBA section. Maybe someone can move it. Sorry.

macropod · #2 02-18-2020, 10:46 PM

Perhaps:

Code:

Sub TblHiLite()
Application.ScreenUpdating = False
Dim r As Long, h As Long, StrTitle As String
With Selection.Tables(1)
  StrTitle = Split(.Cell(2, 1).Range.Text, vbCr)(0)
  .Rows(2).Shading.BackgroundPatternColorIndex = 0
  h = 0
  For r = 3 To .Rows.Count
    If Split(.Cell(r, 1).Range.Text, vbCr)(0) <> StrTitle Then
      If h = 0 Then h = 3 Else h = 0
      StrTitle = Split(.Cell(r, 1).Range.Text, vbCr)(0)
    End If
    .Rows(r).Shading.BackgroundPatternColorIndex = h
  Next
End With
Application.ScreenUpdating = True
End Sub

Jennifer Murphy · #3 02-19-2020, 03:21 AM

Thanks, Paul. That works great.

Where can I find a list of the color codes?

macropod · #4 02-19-2020, 05:03 AM

They're listed under the wdColorIndex enumeration in the VBA Help file. You could use BackgroundPatternColor instead of BackgroundPatternColorIndex, and specify the RGB values.

Jennifer Murphy · #5 02-19-2020, 11:15 AM

Quote:

Originally Posted by macropod

They're listed under the wdColorIndex enumeration in the VBA Help file. You could use BackgroundPatternColor instead of BackgroundPatternColorIndex, and specify the RGB values.

Got it, thanks.

Now, is there a way to pass parameters to the macro? My search suggests that there is not. I have to have the macro ask for parameters using InputBox or a Form.

A couple of parameters that would make this macro more general are:

The number of the column where the text is
Whether the table has a header row or not
The highlight color(s)

Thanks

Jennifer Murphy · #6 02-19-2020, 12:00 PM

I tweaked the code a bit. Here is a working macro. The target text must be in column 1 and the first row is assumed to be a header.

Code:

Sub TblHiLite()

Const MyName As String = "TblHiLite"
'Const Blue As Long = 15849926   'Light blue (198,217,241)
Const Blue As Long = 15853019   'Light blue (219,229,241)
Const White As Long = 16777215  'No highlighting

'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

Application.ScreenUpdating = False
Dim Row As Long           'Row number (loop index)
Dim HiLiteColor As Long   'The ?????
Dim TgtTextNew As String  'The target text string
Dim TgtTextOld As String  'The previous target text string

HiLiteColor = Blue                'Initialize color
With Selection.Tables(1)          'Focus the selection on the table
  For Row = 2 To .Rows.Count         'Loop through all row but the header
    TgtTextNew = Split(.Cell(Row, 1).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 = White Then HiLiteColor = Blue Else HiLiteColor = White
    End If
    .Rows(Row).Shading.BackgroundPatternColor = HiLiteColor 'Apply highlighting
  Next Row
End With
  
Application.ScreenUpdating = True

End Sub

macropod · #7 02-19-2020, 02:29 PM

Quote:

Originally Posted by Jennifer Murphy

Now, is there a way to pass parameters to the macro? My search suggests that there is not. I have to have the macro ask for parameters using InputBox or a Form.

A couple of parameters that would make this macro more general are:

The number of the column where the text is
Whether the table has a header row or not
The highlight color(s)

Passing parameters is quite easy. The usual way is to use code like:
Sub Macro(Parameter1 As Long, Parameter2 As String, Optional Parameter3 As Boolean)
where:
• 'Parameter' 1-3 are the parameter names (more than3 are allowed);
• Long, String & Boolean are the parameter types; and
• Optional indicates that the parameter need not be supplied (these must only come after all the mandatory parameters).
Thus, you might use something along the lines of:

Code:

Sub TblHiLite(ColNum As Long, Hdr As Boolean, Shading 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"
  Exit Sub
End If
Application.ScreenUpdating = False
Dim h As Long, n As Long, r As Long, s As Long, StrTitle As String
Const w As Long = RGB(255, 255, 255)
'Determine the start row, according to whether there's a header
If Hdr = True Then
  n = 3
Else
  n = 2
End If
'Get the applicable colour constant
Select Case Trim(LCase(Shading))
  Case "pale blue": s = RGB(198, 217, 241)
  Case "pale green": s = RGB(153, 255, 153)
  Case "pale yellow": s = RGB(255, 255, 153)
  Case "pink": s = RGB(255, 153, 153)
  Case Else: s = w
End Select
'process the table
With Selection.Tables(1)
  StrTitle = Split(.Cell(n - 1, ColNum).Range.Text, vbCr)(0)
  .Rows(2).Shading.BackgroundPatternColorIndex = 0
  h = w
  For r = n To .Rows.Count
    If Split(.Cell(r, ColNum).Range.Text, vbCr)(0) <> StrTitle Then
      If h = w Then h = s Else h = w
      StrTitle = Split(.Cell(r, ColNum).Range.Text, vbCr)(0)
    End If
    .Rows(r).Shading.BackgroundPatternColor = h
  Next
End With
Application.ScreenUpdating = True
End Sub

Jennifer Murphy · #8 02-19-2020, 03:12 PM

Quote:

Originally Posted by macropod

Passing parameters is quite easy. The usual way is to use code like:
Sub Macro(Parameter1 As Long, Parameter2 As String, Optional Parameter3 As Boolean)
where:
• 'Parameter' 1-3 are the parameter names (more than3 are allowed);
• Long, String & Boolean are the parameter types; and
• Optional indicates that the parameter need not be supplied (these must only come after all the mandatory parameters).

I guess I wasn't clear. I do know how to pass parameters to functions. I have quite a few in operation. They use a syntax like you describe.

But I don't know how to pass them to the Sub. I call my sub using a keyboard shortcut (Alt+Ctrl+Shift+h). Do I have to edit that assignment every time I want to change the parameter values to be passed?

Does that make sense?

macropod · #9 02-19-2020, 03:31 PM

In that case, you might code the sub along the lines of:

Code:

Sub TblHiLite()
Application.ScreenUpdating = False
Dim c As Long, h As Long, n As Long, r As Long, s As Long, w As Long, StrTitle As String, Hdr As Boolean
w = RGB(255, 255, 255)
'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
c = CLng(InputBox("Starting Column?", "TblHiLite"))
If LCase(InputBox("Table has a header row?", "TblHiLite")) = "yes" Then Hdr = True Else Hdr = False
Shading = CLng(InputBox("Colour for Shading? Select # from:" & vbCr & _
  "0: none" & vbCr & _
  "1: pale blue" & vbCr & _
  "2: pale green" & vbCr & _
  "3: pale yellow" & vbCr & _
  "4: pink", "TblHiLite"))
On Error GoTo 0
'Determine the start row, according to whether there's a header
If Hdr = True Then
  n = 3
Else
  n = 2
End If
'Get the applicable colour constant
Select Case s
  Case 1: s = RGB(198, 217, 241)
  Case 2: s = RGB(153, 255, 153)
  Case 3: s = RGB(255, 255, 153)
  Case 4: s = RGB(255, 153, 153)
  Case Else: s = w
End Select
'process the table
With Selection.Tables(1)
  If c > .Columns.Count Then
    MsgBox "There is no column " & c & " in the table!", vbOKOnly, "TblHiLite"
    GoTo ErrExit
  End If
  StrTitle = Split(.Cell(n - 1, c).Range.Text, vbCr)(0)
  .Rows(2).Shading.BackgroundPatternColorIndex = 0
  h = w
  For r = n 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
ErrExit:
Application.ScreenUpdating = True
End Sub

Jennifer Murphy · #10 02-19-2020, 03:54 PM

OK, so then an InputBox or Form is the way to pass parameters, right?

Thanks

macropod · #11 02-19-2020, 04:00 PM

Unless you want to go to the trouble of creating a userform, I'd stick with inputboxes for something as simple as this.

Jennifer Murphy · #12 02-20-2020, 11:48 AM

Thanks to Paul's help, I now have a macro that does just what I need. I did not add the InputBox code as I don't need it right now. I'll add that later if I do.

Here's the code in case it might be useful for anyone else:

Code:

'===========================================================================
'                        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

Jennifer Murphy · #13 02-20-2020, 01:44 PM

PS: Can anyone suggest a better way to initialize TgtTextOld than:

Code:

TgtTextOld = "!@#$%^&*()=+{}[]<>"

How about initializing it to the first string plus 1 character?

macropod · #14 02-20-2020, 02:46 PM

Have a look at how my code initialises StrTitle.

Jennifer Murphy · #15 02-20-2020, 07:30 PM

Quote:

Originally Posted by macropod

Have a look at how my code initialises StrTitle.

Perfect, will do. I also notice that you have code for checking that the column number is in bounds, so I'll add that, too.

Do you have a way for the macro to read the line (paragraph) just before the table? If so, I could put the parameters there.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to highlight a list of words	bakerkr	Word VBA	4	10-19-2017 02:23 PM
Word 2010 VBA Print Macro - Specified Sections	Benbon	Word VBA	3	03-30-2017 02:31 PM
Macro Question: Need help making a macro to highlight the first word in every sentence	LadyAna	Word	1	12-06-2014 10:39 PM
Macro to highlight words	bertietheblue	Word VBA	9	07-01-2013 12:39 PM
find - reading highlight - highlight all / highlight doesn't stick when saved	bobk544	Word	3	04-15-2009 03:31 PM