Sub Another_Go()
'
Application.ScreenUpdating = False
'If the selection includes tables, error 4605 will be returned.
'Thus an error handler is needed:
On Error Resume Next
    For Each oPara In ActiveDocument.range.Paragraphs
        oPara.range.Select
        selection.End = selection.End - 1
        selection.Shading.BackgroundPatternColor = -654246042
    Next oPara
Application.ScreenUpdating = True
End Sub