Remove Duplicates From Selected Cells

This macro is useful for removing duplicates on the selected data.

*************************************************************************
Code:

Sub RemoveDuplicate()


Dim ConstRange As Range, FrmRange As Range
Dim FullRange As Range, rCell As Range
Dim iCount As Long
Dim strAdd As String

DialogStyle = vbYesNo + vbCritical + vbDefaultButton2
Title = "Deleting Duplicates"
Msg = "Are you sure you want to delete entire rows?"
deleteDupRows = MsgBox(Msg, DialogStyle, Title)

If deleteDupRows = vbYes Then
   
    On Error Resume Next

    Set FullRange = Selection
        If WorksheetFunction.CountA(FullRange) < 2 Then
            MsgBox "Select more than one cell", vbInformation
            On Error GoTo 0
            Exit Sub
        End If

    Set ConstRange = FullRange.SpecialCells(xlCellTypeConstants)
    Set FrmRange = FullRange.SpecialCells(xlCellTypeFormulas)

    If Not ConstRange Is Nothing And Not FrmRange Is Nothing Then
        Set FullRange = Union(ConstRange, FrmRange)
    ElseIf Not ConstRange Is Nothing Then
        Set FullRange = ConstRange
    ElseIf Not FrmRange Is Nothing Then
        Set FullRange = FrmRange
    Else
        MsgBox "Invalid Selection", vbInformation

        On Error GoTo 0
       
        Exit Sub
   
    End If

    Application.Calculation = xlCalculationManual

    For Each rCell In FullRange

        strAdd = rCell.Address
        strAdd = FullRange.Find(What:=rCell, After:=rCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Address

        If strAdd <> rCell.Address Then
            rCell.Clear
        End If

    Next rCell

End If
 

    Application.Calculation = xlCalculationAutomatic

    On Error GoTo 0

End Sub

*************************************************************************