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

Hi JapanDave,

I slightly modified the code to suit my need, but I'm stuck. Please see the attached.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Mbox As String
    Dim LR As Long, i As Long, found As Range
    Application.ScreenUpdating = False
     On Error Resume Next
        LR = Worksheets("Sub").Cells(Rows.Count, 1).End(xlUp).Row
if target.column = 1 then    
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Set found = Range("a:a").Find(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
end if
    
    Set found = Nothing
    Application.ScreenUpdating = True
End Sub

In the workbook, I have two worksheets, "main" and "sub" and I'm putting the code in the "Main" worksheet.

What I would like to do:

You see in "sub" worksheet, there is a record 123 with diagnosis of "Neither".

Suppose, now you are entering the record 123 in "Main" without knowing that it has been entered in the "sub.

I would like to find a way to check or alert user that the record 123 has been entered in the "sub" already if the user is now trying to enter the same patient. then, I want excel to actually delete the 123 from the "sub", not from the "main".

Is this doable?


I put

if target.column = 1

so that it doesn't do this every time user moves to the next field. Is this right?

Thank you.