Sub HighlightPlus()
' Paul Beverley - Version 24.03.21
' Adds highlight in a choice of colours

Dim myCol(20)
myCol(0) = wdNoHighlight
myCol(1) = wdBrightGreen
myCol(2) = wdYellow
myCol(3) = wdTurquoise
myCol(4) = wdPink
myCol(5) = wdRed
myCol(6) = wdGreen
myCol(7) = wdDarkYellow
myCol(9) = wdGray25
myCol(8) = wdGray50
myColTotal = 9

' Remember track changes status, then switch it off
myTrack = ActiveDocument.TrackRevisions
ActiveDocument.TrackRevisions = False

Dim v As Variable, nowColour As Long
varsExist = False
For Each v In ActiveDocument.Variables
  If v.Name = "colNum" Then varsExist = True: Exit For
Next v

If varsExist = False Then
  ActiveDocument.Variables.Add "selStart", 0
  ActiveDocument.Variables.Add "selEnd", 0
  ActiveDocument.Variables.Add "colNum", 0
End If

wasStart = ActiveDocument.Variables("selStart")
wasEnd = ActiveDocument.Variables("selEnd")
wasCol = ActiveDocument.Variables("colNum")
' If no text is selected ...
If Selection.Start = Selection.End Then
  If Selection.Text = vbCr Then Selection.MoveLeft , 1
  ' If the cursor is outside the area, give up
  If Selection.Start < wasStart Or Selection.End > wasEnd Then
    Selection.Expand wdWord
    ActiveDocument.Variables("selStart") = Selection.Start
    ActiveDocument.Variables("selEnd") = Selection.End
    nowCol = 1
  Else
    ' Otherwise check the highlight colour
    Selection.Start = wasStart
    Selection.End = wasStart + 1
    nowColour = Selection.Range.HighlightColorIndex
    If nowColour <> myCol(wasCol) Then
      ' colour has changed, so go back to colour 1
      nowCol = 1
    Else
      ' go to next colour
      nowCol = wasCol + 1
      If nowCol > myColTotal Then nowCol = 0
    End If
    Selection.End = wasEnd
  End If
Else:  ' if some text is selected ...
  ' Record current selection range
  ActiveDocument.Variables("selStart") = Selection.Start
  ActiveDocument.Variables("selEnd") = Selection.End
  nowCol = 1
End If
ActiveDocument.Variables("colNum") = nowCol
Selection.Range.HighlightColorIndex = myCol(nowCol)
Selection.End = Selection.Start

theEnd:
ActiveDocument.TrackRevisions = myTrack
End Sub