Sub SortAndRemoveDups()
' Paul Beverley - Version 19.09.18
' Sort the selected text

If Selection.End = Selection.Start Then
  myResponse = MsgBox("Sort the WHOLE file?", _
       vbQuestion + vbYesNo)
  If myResponse = vbNo Then Exit Sub
  Selection.WholeStory
End If
myStart = Selection.Start
myEnd = Selection.End

' Exchange rogue linefeed (ascii 10)
Set rng = ActiveDocument.Content
With rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "^10"
  .Wrap = wdFindContinue
  .Replacement.Text = "^p"
  .Forward = True
  .MatchCase = False
  .MatchWildcards = False
  .Execute Replace:=wdReplaceAll
End With

Selection.Sort ExcludeHeader:=False, FieldNumber:="Paragraphs", SortOrder:=wdSortOrderAscending
Selection.Start = myStart
Selection.End = myEnd
For j = 1 To ActiveDocument.Paragraphs.Count
  If ActiveDocument.Paragraphs(j).Range.Start > myStart Then Exit For
Next j
listStart = j - 1
For j = ActiveDocument.Paragraphs.Count To 1 Step -1
  If ActiveDocument.Paragraphs(j).Range.Start < myEnd Then Exit For
Next j
listEnd = j
For j = listEnd To listStart + 1 Step -1
  Set rng1 = ActiveDocument.Paragraphs(j).Range
  Set rng2 = ActiveDocument.Paragraphs(j - 1).Range
  If rng1 = rng2 Then rng1.Delete
  StatusBar = "Lines to go: " & Str(j)
Next j
StatusBar = ""
ActiveDocument.Paragraphs(listStart).Range.Select
Selection.End = Selection.Start
End Sub