27 | 07 | 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
    Else
 
        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
            rCell.Clear
 
        End If
 
    Next rCell
 
    Application.Calculation = xlCalculationAutomatic
 
    On Error GoTo 0
 
End Sub
Login

Sign up now and upload your code to the website.

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