Sub CheckDuplicates()
Dim oTable As Table
Dim oCell1 As Range, oCell2 As Range
Dim i As Long
    If Not Selection.Information(wdWithInTable) Then
        Beep
        MsgBox "The cursor is not in a table?"
        GoTo lbl_Exit
    End If
    Set oTable = Selection.Tables(1)
    oTable.Sort ExcludeHeader:=False, FieldNumber:="Column 2", _
                SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
    DoEvents
    For i = 2 To oTable.Rows.Count - 1
        Set oCell1 = oTable.Rows(i).Cells(2).Range
        oCell1.End = oCell1.End - 1
        Set oCell2 = oTable.Rows(i + 1).Cells(2).Range
        oCell2.End = oCell2.End - 1
        If oCell1.Text = oCell2.Text Then
            oCell1.HighlightColorIndex = wdYellow
            oCell2.HighlightColorIndex = wdYellow
        End If
    Next i
    oTable.Sort ExcludeHeader:=False, FieldNumber:="Column 1", _
                SortFieldType:=wdSortFieldNumeric, SortOrder:=wdSortOrderAscending
lbl_Exit:
    Set oTable = Nothing
    Set oCell1 = Nothing
    Set oCell2 = Nothing
    Exit Sub
End Sub