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

**Winon** · 01-22-2012, 02:12 AM

@ JapanDave,

That's it! Very kind of you. It works perfectly! I should have thought about shortening the clearing bit, myself, but for some stupid action from my side, just did not think of it! How Dumb can i get??

You have been "Promoted" and now share a spot on my wall for people of NOTE! Congratulations! I don't award everyone with such a pretigeous honor.

Once again, Thank you for your help.

I have also added to your Rep.

Keep well, and keep up the good work!!!

**JapanDave** · 01-22-2012, 03:04 AM

Thanks Winon, and thanks for the rep. Let me know If I can help you out further?

Lifeseeker, if this thread is solved, please go to advance edit and mark it solved.

**Lifeseeker** · 01-22-2012, 04:24 AM

Originally Posted by JapanDave

Thanks Winon, and thanks for the rep. Let me know If I can help you out further?

Lifeseeker, if this thread is solved, please go to advance edit and mark it solved.

Hi JapanDave,

I will call it solved for now as I have not implemented on my system yet, but I trust that it will work out fine. Let me give it a try tomorrow!

Thanks again

**Lifeseeker** · 01-22-2012, 05:13 AM

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.

**JapanDave** · 01-22-2012, 06:37 AM

How is the Main worksheet and sub worksheet linked? At present they are not linked.

**Lifeseeker** · 01-22-2012, 08:48 PM

Originally Posted by JapanDave

How is the Main worksheet and sub worksheet linked? At present they are not linked.

Did I have to link the two workbooks in this case?

How do I do so?

Thanks

**JapanDave** · 01-22-2012, 09:44 PM

Lifeseeker,
OK, so you manually input data into both sheets and they are not linked. Got that.

I don't know what you want deleted, so for the time being this macro deletes the duplicate you just entered (Tell me if you want it another way?). Enter 123 in cell A3 and see if this is what you are after?

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim ws As Worksheet, ws1 As Worksheet
 Dim Mbox As String, cVal As Range, LR1 As Long
 Dim LR As Long, i As Long, found As Range, cel As Range, rng As Range
 Dim cell_to_test As Range
 
     Set ws1 = Sheets("Main")
     LR1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
     
    If Not Intersect(Target, Range("A" & LR1)) Is Nothing Then
          
        Application.ScreenUpdating = 0
        Application.EnableEvents = 0
           Set ws = Sheets("Sub")
           On Error Resume Next
              LR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
              Set rng = ws.Range("A2:A" & LR)
              
              Set cVal = ws1.Cells(LR1, 1)
                  For Each cel In rng
                      Set found = rng.Find(what:=cVal, 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
                               cVal.ClearContents
                              Else
                               Resume Next
                              End If
                            End If
                          End If
                  Next cel
      End If
          Set found = Nothing
        Application.EnableEvents = 1
        Application.ScreenUpdating = 1
End Sub

Edit: The system is not allowing me to upload a file, paste this in the worksheet module for "Main".
Edit* it worked. See file

**Lifeseeker** · 01-22-2012, 11:31 PM

Hi JapanDave,

I would like the duplicate on the sub be deleted, not the main.

So, say....if 123 already exists in sub, and when user is entering the 123 in the Main without knowing that it is already there in the sub, the system prompt user to delete the 123 from the sub, not from the main.

Possible?

**JapanDave** · 01-23-2012, 01:25 AM

Try this,
It deletes the entire row in the Sub worksheet.

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim ws As Worksheet, ws1 As Worksheet
 Dim Mbox As String, cVal As Range, LR1 As Long
 Dim LR As Long, i As Long, found As Range, cel As Range, rng As Range
 Dim del As Variant
 
     Set ws1 = Sheets("Main")
     LR1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
     
    If Not Intersect(Target, Range("A" & LR1)) Is Nothing Then
          
        Application.ScreenUpdating = 0
        Application.EnableEvents = 0
           Set ws = Sheets("Sub")
           On Error Resume Next
              LR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
              Set rng = ws.Range("A2:A" & LR)
              
              Set cVal = ws1.Cells(LR1, 1)
                  For Each cel In rng
                      Set found = rng.Find(what:=cVal, 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
                                del = found.Address
                                ws.Range(del).EntireRow.Delete
                              Else
                               Resume Next
                              End If
                            End If
                          End If
                  Next cel
      End If
          Set found = Nothing
        Application.EnableEvents = 1
        Application.ScreenUpdating = 1
End Sub

**Lifeseeker** · 01-23-2012, 02:16 AM

Hey JapanDave,

I want to give you millions of thanks. Wow, this is wonderful.

Thank you.

btw, I've fixed the workbook extract thing. it was the working code. But it didn't work because I had other workbooks open. Excel doesn't seem to like it when other workbooks are already open, strangely.

**JapanDave** · 01-23-2012, 02:32 AM

Great I could have helped.

Dave

**Lifeseeker** · 01-23-2012, 07:24 PM

Hi JapanDave,

Actually, due to changing priority, I would like to tie up the loose end of the other one where users are inputing record in main and it detects duplicates against the sub. (your code worked outside my system, but not inside)

After i put your code in my system and put in a test record in main, it then started looping infinitely until i got a message saying over stack and something like outside something something failed...can't recall exactly, then the system froze.

the code is in the worksheet_change event and whereas your code says "A" i changed it to "E" because col E is the look up column.

Should this have happened normally?

can you simply put the code in the worksheet_change event?

I have made sure that i got rid of the application.enableevents pair because i'm just adding these lines into other lines.

Any ideas?

Sorry to bother you again!