Sub HighlightMinus()
' Paul Beverley - Version 15.04.22
' Removes or adds highlight in a choice of colours

doUnderlinesToo = True
doColourOffToo = True
strikeThroughToo = True

addWarning = True

doParagraph = True
' False means act on current line

Set rng = ActiveDocument.Content
If Selection.Text = rng.Text Then
  If addWarning = True Then
    Beep
    myResponse = MsgBox("Remove colour, highlight, strike-through (and underlining)?", _
         vbQuestion + vbYesNoCancel, "HighlightMinus")
    If myResponse <> vbYes Then
      doUnderlinesToo = False
      doColourOffToo = False
      strikeThroughToo = False
    End If
  End If

  Set rng = ActiveDocument.Content
  rng.HighlightColorIndex = wdNoHighlight
  If doColourOffToo = True Then rng.Font.Color = wdColorAutomatic
  If strikeThroughToo = True Then rng.Font.StrikeThrough = False
  If doUnderlinesToo = True Then rng.Font.Underline = False
  
  If ActiveDocument.Footnotes.count > 0 Then
    Set rng = ActiveDocument.StoryRanges(wdFootnotesStory)
    rng.HighlightColorIndex = wdNoHighlight
    If doColourOffToo = True Then rng.Font.Color = wdColorAutomatic
    If strikeThroughToo = True Then rng.Font.StrikeThrough = False
    If doUnderlinesToo = True Then rng.Font.Underline = False
  End If
  
  If ActiveDocument.Endnotes.count > 0 Then
    Set rng = ActiveDocument.StoryRanges(wdEndnotesStory)
    rng.HighlightColorIndex = wdNoHighlight
    If strikeThroughToo = True Then rng.Font.StrikeThrough = False
    If doColourOffToo = True Then rng.Font.Color = wdColorAutomatic
    If doUnderlinesToo = True Then rng.Font.Underline = False
  End If
  Selection.HomeKey Unit:=wdStory
  Exit Sub
End If

Dim myCol(9)
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(8) = wdGray50
myCol(9) = wdGray25
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 - 1 Then GoTo LineClear
  ' 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 = 0
  Else
    ' go to next colour
    nowCol = wasCol - 1
    If nowCol < 0 Then nowCol = myColTotal
  End If
  Selection.End = wasEnd
Else
  ' if some text is selected
  ' record the current selection range
  ActiveDocument.Variables("selStart") = Selection.Start
  ActiveDocument.Variables("selEnd") = Selection.End
  nowCol = 0
End If
ActiveDocument.Variables("colNum") = nowCol
'    This following line solves the problem where text
'    is highlighted, yet its colour is apparently 0(!)
'    so force it to turquoise, then back to 0.
If nowCol = 0 And Selection.Range.HighlightColorIndex = 0 Then
  Selection.Range.HighlightColorIndex = 3
End If
Selection.Range.HighlightColorIndex = myCol(nowCol)
Selection.End = Selection.Start
ActiveDocument.TrackRevisions = myTrack
Exit Sub

LineClear:
If doParagraph = True Then
  Selection.Expand wdParagraph
Else
  Selection.HomeKey Unit:=wdLine
  clearStart = Selection.Start
  Selection.MoveDown Unit:=wdLine, count:=1
  Selection.HomeKey Unit:=wdLine
End If
Set rng = Selection.Range
rng.Start = clearStart
ActiveDocument.Variables("selStart") = clearStart
ActiveDocument.Variables("selEnd") = Selection.End
rng.HighlightColorIndex = wdNoHighlight
ActiveDocument.TrackRevisions = myTrack
Selection.Collapse wdCollapseEnd
End Sub