22 | 02 | 2017

Remove Duplicates from Excel Selection

When you are struggling with a lot of duplicate items in a range of cells use the code below. First select a range of cells and then start the code. This code clears the cells containing duplicate items.
Sub Removeduplicates()
'*** Code from VisibleVisual.com ********
Dim rConstRange As Range, rFormRange As Range
Dim rAllRange As Range, rCell As Range
Dim iCount As Long
Dim strAdd As String
    On Error Resume Next
    Set rAllRange = Selection
        If WorksheetFunction.CountA(rAllRange) < 2 Then
            MsgBox "Invalid Selection", vbInformation
            On Error GoTo 0
            Exit Sub
        End If
    Set rConstRange = rAllRange.SpecialCells(xlCellTypeConstants)
    Set rFormRange = rAllRange.SpecialCells(xlCellTypeFormulas)
    If Not rConstRange Is Nothing And Not rFormRange Is Nothing Then
        Set rAllRange = Union(rConstRange, rFormRange)
    ElseIf Not rConstRange Is Nothing Then
        Set rAllRange = rConstRange
    ElseIf Not rFormRange Is Nothing Then
        Set rAllRange = rFormRange
        MsgBox "You selection is not valid", vbInformation
        On Error GoTo 0
        Exit Sub
    End If
    Application.Calculation = xlCalculationManual
    For Each rCell In rAllRange
        strAdd = rCell.Address
        strAdd = rAllRange.Find(What:=rCell, After:=rCell, LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Address
        If strAdd <> rCell.Address Then
            'clear the cell that contains the duplicate item
        End If
    Next rCell
    Application.Calculation = xlCalculationAutomatic
    On Error GoTo 0
End Sub

Sign up now and upload your code to the website.

Help us to continue.....
Articles View Hits
Latest Articles