Sub PatternClear()
' Paul Beverley - Version 10.01.25
' Removes shading and other funny colours

myDo = "S"
If Selection.start = Selection.End Then
  Beep
  myResponse = MsgBox("Clear patterns from the whole document?!", _
       vbQuestion + vbYesNoCancel, "PatternClear")
  If myResponse <> vbYes Then Exit Sub
  myDo = "TEF"
End If

If ActiveDocument.Footnotes.count = 0 Then myDo = Replace(myDo, "F", "")
If ActiveDocument.Endnotes.count = 0 Then myDo = Replace(myDo, "E", "")

myTrack = ActiveDocument.TrackRevisions
ActiveDocument.TrackRevisions = False

For i = 1 To Len(myDo)
  doIt = Mid(myDo, i, 1)
  Select Case doIt
     Case "S": Set rng = Selection.Range.Duplicate
     Case "T": Set rng = ActiveDocument.Content
     Case "F": Set rng = ActiveDocument.StoryRanges(wdFootnotesStory)
     Case "E": Set rng = ActiveDocument.StoryRanges(wdEndnotesStory)
  End Select
  
  ' Do whatever with rng
  rng.Font.Shading.BackgroundPatternColor = wdColorAutomatic
  rng.ParagraphFormat.Shading.BackgroundPatternColor = wdColorAutomatic
  rng.Shading.Texture = wdTextureNone
  rng.Shading.ForegroundPatternColor = wdColorAutomatic
  rng.Shading.BackgroundPatternColor = wdColorAutomatic
Next i
ActiveDocument.TrackRevisions = myTrack
End Sub