Thread: Finding duplicates in a column, prompt user then delete the current one

Hi there,

I would like to have few lines to code to let Excel first find duplicates against column 1 when users enter new record. If a duplicate is found, then a pop-up window saying duplicate is found or something like that and then have Excel delete the current line so that we don't have to manually delete it by right-clicking then hit "Delete".

The list goes on forever so I thought I should use a macro in worksheet change event, but i don' tknow how to get started.

Is this possible?

Please see the attached file.

Thank you

How about something like this?

This just deletes the cell contents as your file is empty and I am not sure if you want the entire row deleted or entire column deleted.

Option Explicit
Sub d()
    Dim Mbox As String
    Dim LR As Long, i As Long, found As Range
    Application.ScreenUpdating = False
     On Error Resume Next
        LR = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Set found = Range("a:a").Find(what:=Cells(i, "b"), LookIn:=xlValues, LookAt:=xlWhole)
      If Not found Is Nothing Then
            Mbox = MsgBox("Duplicate Found, do you want to delete duplicate", vbYesNo, "Duplicate")
        If Mbox = vbYes Then
          Cells(i, "b").EntireRow.Delete
        Else
        End If
      End If
    Next i
    
    Set found = Nothing
    Application.ScreenUpdating = True
End Sub

Originally Posted by Lifeseeker

Clear cell contents if the next value you enter in col a has a duplicate.

I had already modified the code to delete the entire row. You can have it delete from cells 1- 60 , but that will leave a blank row?

I don't understand what you are saying in this sentence?

@ JapanDave,

Your Code works Fine! I tried to tweak it to only Clear the Range found with duplicates, but it does'nt work?

Hey Winon,

Try this and see if it works for you?

Option Explicit
Sub d()
    Dim Mbox As String
    Dim LR As Long, i As Long, found As Range
    Application.ScreenUpdating = False
     On Error Resume Next
        LR = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Set found = Range("a:a").Find(what:=Cells(i, "b"), LookIn:=xlValues, LookAt:=xlWhole)
      If Not found Is Nothing Then
            Mbox = MsgBox("Duplicate Found, do you want to delete entire row contents?", vbYesNo, "Duplicate")
        If Mbox = vbYes Then
          Rows(i).ClearContents
        Else
          Mbox = vbNo
        Resume Next
        End If
      End If
    Next i
    
    Set found = Nothing
    Application.ScreenUpdating = True
End Sub

@ JapanDave,

Thank you very much for your time and effort. The code Clears the whole Row though, while I am trying to get it to clear only the range- Colums A through to Column i. This has been bugging me for a long time now.

I am not sure I understand.

Eg, if you find a duplicate from what column to what column in what row do you want to clear?

OK, how about this?

Option Explicit
Sub d()
    Dim Mbox As String
    Dim LR As Long, i As Long, found As Range
    Application.ScreenUpdating = False
     On Error Resume Next
        LR = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Set found = Range("a:a").Find(what:=Cells(i, "b"), LookIn:=xlValues, LookAt:=xlWhole)
      If Not found Is Nothing Then
            Mbox = MsgBox("Duplicate Found, do you want to delete duplicate", vbYesNo, "Duplicate")
        If Mbox = vbYes Then
          Range(Cells(i, 1), Cells(i, 9)).ClearContents
        Else
          Mbox = vbNo
        Resume Next
        End If
      End If
    Next i
    
    Set found = Nothing
    Application.ScreenUpdating = True
End Sub

Hey Winon,

Try this and see if it is what you are after?

Option Explicit
Sub d()
    Dim Mbox As String
    Dim LR As Long, i As Long, found As Range
    Application.ScreenUpdating = False
     On Error Resume Next
        LR = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Set found = Range("a:a").Find(what:=Cells(i, "b"), LookIn:=xlValues, LookAt:=xlWhole)
          If found <> vbNullString Then
            If Not found Is Nothing Then
                  Mbox = MsgBox("Duplicate Found, do you want to delete duplicate", vbYesNo, "Duplicate")
              If Mbox = vbYes Then
                Range(Cells(i, 1), Cells(i, 9)).ClearContents
              Else
                Mbox = vbNo
              Resume Next
              End If
            End If
          End If
    Next i
    
    Set found = Nothing
    Application.ScreenUpdating = True
End Sub