Sub NormaliseText()
' Paul Beverley - Version 03.04.21
' Sets Normal style and removes (some) formatting

removeHighlight = True
removeColour = True

' To reset some features, not all, set to False:
resetAllFormat = False

' which, if true, makes these redundant
resetBoldItalic = True
resetFontName = True
resetFontSize = True
resetSubSuper = True

If Selection.Start = Selection.End Then Selection.Expand wdParagraph

Set rng = Selection.Range.Duplicate
numParas = Len(rng) - Len(Replace(rng, vbCr, ""))
If Right(rng, 1) = vbCr Then rng.MoveEnd , -1

If numParas > 0 And Right(rng, 1) <> vbCr Then
  rng.MoveStartUntil cset:=vbCr, Count:=wdBackward
  rng.MoveEndUntil cset:=vbCr, Count:=wdForward
  rng.MoveEnd , 1
End If
rng.Select

If resetAllFormat = False Then
  If removeHighlight = True Then rng.HighlightColorIndex = wdNoHighlight
  
  If removeColour = True Then rng.Font.Color = wdAuto

  If resetSubSuper = True Then
    rng.Font.Superscript = False
    rng.Font.Subscript = False
  End If
  
  If resetBoldItalic = True Then
    rng.Bold = False
    rng.Italic = False
  End If
  
  If resetFontName = True Then
    myFont = ActiveDocument.Styles(wdStyleNormal).Font.Name
    rng.Font.Name = myFont
  End If
  
  If resetFontSize = True Then
    mySize = ActiveDocument.Styles(wdStyleNormal).Font.Size
    rng.Font.Size = mySize
  End If
Else
  rng.Style = wdStyleNormal
  On Error GoTo ReportIt
  rng.Font.Reset
End If
Selection.Collapse wdCollapseEnd
Exit Sub

ReportIt:
Beep
End Sub