Sub UnHighlightAndColour() ' Paul Beverley - Version 04.11.17 ' Removes all highlight/coloration of the current colour Set wasSelected = Selection.range.Duplicate Selection.Collapse wdCollapseStart Selection.MoveEnd , 1 myColour = Selection.range.Font.ColorIndex If myColour = 1 Then myColour = 0 myHighlight = Selection.range.HighlightColorIndex styleColour = Selection.range.Style.Font.ColorIndex If myColour + myHighlight = 0 Then MsgBox "Please place the cursor in the colour/highlight to be removed." Exit Sub End If If myColour > 0 And myColour = styleColour Then MsgBox "Sorry, this macro doesn't work with colours in styles." Exit Sub End If Set rng = ActiveDocument.Content mixedColour = 9999999 If myHighlight > 0 Then For Each myPara In rng.Paragraphs col = myPara.range.HighlightColorIndex If col <> mixedColour Then If col = myHighlight Then myPara.range.HighlightColorIndex = wdNoHighlight Else For Each wd In myPara.range.Words col = wd.HighlightColorIndex If col <> mixedColour Then If col = myHighlight Then wd.HighlightColorIndex = wdNoHighlight Else For Each ch In wd.Characters col = ch.HighlightColorIndex If col <> mixedColour Then If col = myHighlight Then _ ch.HighlightColorIndex = wdNoHighlight End If DoEvents Next ch End If DoEvents Next wd End If DoEvents j = j + 1 If j Mod 5 = 0 Then myPara.range.Select Selection.Collapse wdCollapseEnd End If Next myPara Else For Each myPara In rng.Paragraphs col = myPara.range.Font.ColorIndex If col <> mixedColour Then If col = myColour Then myPara.range.Font.ColorIndex = wdNoHighlight Else For Each wd In myPara.range.Words col = wd.Font.ColorIndex If col <> mixedColour Then If col = myColour Then wd.Font.ColorIndex = wdNoHighlight Else For Each ch In wd.Characters col = ch.Font.ColorIndex If col <> mixedColour Then If col = myColour Then ch.Font.ColorIndex = wdNoHighlight End If DoEvents Next ch End If DoEvents Next wd End If DoEvents Next myPara End If Application.ScreenUpdating = False Selection.EndKey Unit:=wdStory wasSelected.Select Application.ScreenUpdating = True ActiveDocument.ActiveWindow.SmallScroll down:=1 Beep End Sub