Sub DuplicatesRemove()
' Paul Beverley - Version 10.07.19
' Remove duplicate items from a list

anyCase = True

' 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

If Selection.End = Selection.Start Then
  myResponse = MsgBox("Remove duplicates from the WHOLE file?", _
       vbQuestion + vbYesNo)
  If myResponse = vbNo Then Exit Sub
  listEnd = ActiveDocument.Paragraphs.Count
  listStart = 1
Else
  myStart = Selection.Start
  myEnd = Selection.End
    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
End If

For j = listEnd To listStart + 1 Step -1
  Set rng1 = ActiveDocument.Paragraphs(j).range
  Set rng2 = ActiveDocument.Paragraphs(j - 1).range
  If anyCase = True Then
    r1 = LCase(rng1)
    r2 = LCase(rng2)
  Else
    r1 = rng1
    r2 = rng2
  End If
  If r1 = r2 Then rng1.Delete
  StatusBar = "Lines to go: " & Str(j)
  DoEvents
Next j
StatusBar = ""
ActiveDocument.Paragraphs(listStart).range.Select
Selection.End = Selection.Start
End Sub