Sub MarkQuotedLines()
Dim orng As Range
With Selection
.HomeKey wdStory
Set orng = Selection.Range
orng.End = orng.End + 2
If orng.Text = "'s" Then
orng.Paragraphs(1).Range.Font.Color _
= wdColorRed
End If
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = True
While .Execute("^13's")
Set orng = Selection.Range
orng.Start = orng.Start + 1
orng.Paragraphs(1).Range.Font.Color _
= wdColorRed
Wend
End With
End With
End Sub