• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User


  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA code to remove duplicate cells


New Member

Is there a VBA code to remove duplicate cells form the active sheet to use while creating a macro?


Well-Known Member
Option Explicit

Sub DeleteDuplicateRows()
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That is,
' if the same value is found more than once in the Active Column, all but
' the first (lowest row number) will be deleted.
' To run the macro, select the entire column you wish to scan for
' duplicates, and run this procedure.

    Dim r As Long
    Dim n As Long
    Dim V As Variant
    Dim rng As Range

    On Error GoTo EndMacro
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set rng = Application.Intersect(ActiveSheet.UsedRange, _

    Application.StatusBar = "Processing Row: " & Format(rng.Row, "#,##0")

    n = 0
    For r = rng.Rows.Count To 2 Step -1
        If r Mod 500 = 0 Then
            Application.StatusBar = "Processing Row: " & Format(r, "#,##0")
        End If

        V = rng.Cells(r, 1).Value
        ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
        ' Rather than pass in the variant, you need to pass in vbNullString explicitly.
        If V = vbNullString Then
            If Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Then
                n = n + 1
            End If
            If Application.WorksheetFunction.CountIf(rng.Columns(1), V) > 1 Then
                n = n + 1
            End If
        End If
    Next r


    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Duplicate Rows Deleted: " & CStr(n)

End Sub