Highlight duplicate and ask to delete duplicates-CodePudding

in excel sheet the user have doing data entry in column A to H

in col A - id
   col B - Name
   col C - DOB
   col D - Mobile
   col E - Email id
   col F - Res-Address
   col G - City
   col H - State

in this data the user have to found and remove duplicate on entire row in col E - Email id & if user enter data with same Email id & then already exists data should be highlight with color on entire row and will show Msgbox You Enter Duplicate Data is Already Exist See Row has Highlighted if you want delete duplicate click (yes)

here i found a vba code and applied on my worksheet to avoid duplicates automatically when user enter any duplicate data

i have getting (compile error) in this code


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range
Dim cell As String
Dim lCount As Long

Set rRange = Range("E1", Range("E" & Rows.Count).End(xlUp))
lCount = rRange.Rows.Count

For lCount = lCount To 1 Step -1
    With rRange.Cells(lCount, 1)
        If WorksheetFunction.CountIf(rRange, .Value) > 1 Then
           .EntireRow.Interior.ColorIndex = 27
        MsgBox "You Enter Duplicate Data is Already Exist See Row has Highlighted " & vbNewLine & " If you want to Delete Duplicate Click (Yes)   vbYesNo   vbDefaultButton2 = vbYes Then"
           .EntireRow.Delete
            MsgBox "Duplicate Entry Deleted"
        End If
        End If
    End With
Next lCount

End Sub

CodePudding user response：

Firstly, remove the second End If.

Secondly, you must have Option Explicit at the top of your module. If you want that to remain, then you need to define rRange.

If you remove Option Explicit, it should go away. The former is the best approach.

This compiles ...

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lCount As Long
    
    Dim rRange As Range

    Set rRange = Range("E1", Range("E" & Rows.Count).End(xlUp))
    lCount = rRange.Rows.Count
    
    For lCount = lCount To 1 Step -1
        With rRange.Cells(lCount, 1)
            If WorksheetFunction.CountIf(rRange, .Value) > 1 Then
               .EntireRow.Interior.ColorIndex = 27
            MsgBox "You Enter Duplicate Data is Already Exist See Row has Highlighted " & vbNewLine & " If you want to Delete Duplicate Click (Yes)   vbYesNo   vbDefaultButton2 = vbYes Then"
               .EntireRow.Delete
                MsgBox "Duplicate Entry Deleted"
            End If
        End With
    Next lCount
End Sub

... not sure if it does what you want though.