Message box if duplicate found and clear the data from corresponding cells

[sahal]

NEED URGENT HELP!

HELLO

I have been trying to find a way to get this worked but have been unsuccessful.
I am trying to get a pop message when duplicate values are found in Column C which generates a unique code (only numbers) when values in column D,E,F,G,H,I,J,K and L are inserted ( in the same row), also I want to remove the values from D,E,F,G,H,I,J,K and L after getting the pop message.

Any help is greatly appreciated!

 

[JLGWhiz]

You would need to use the Worksheet_Change event code to detect the insertion of values in columns D:L. Then If the change qualifies, use a Apllication.CountIf statement for the value in column C of that row to determine if it is greater than 1 for column C. If it is, the clear range D:L.

 

[sahal]

Thank you for your response.


Could you please help me create a VBA code for this?

I tried creating one, but its not able to find duplicates among the codes created by the formula.

 

[sahal]

I tried with the code below, but it seems something is wrong and its not able to find the duplicates among the codes produced by the formula.


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 3 And Len(Target.Value) > 0 Then

If Evaluate("Countif(C:C," & Target.Address & ")") > 1 Then
MsgBox Target.Value & " is a duplicate entry. It will be removed.", vbExclamation, "Data Entry Editor"
Range("D" & Target.Row & ":E" & Target.Row & ":F" & Target.Row & ":G" & Target.Row & ":H" & Target.Row & ":I" & Target.Row & ":J" & Target.Row & ":K" & Target.Row & ":L" & Target.Row).ClearContents

End If

End If

End Sub

 

[L. Howard]

Try it like this.

Howard

Private Sub Worksheet_Change(ByVal Target As Range)

 If Target.Count > 1 Then Exit Sub
 If Target.Column = 3 And Len(Target.Value) > 0 Then

   If Evaluate("Countif(C:C," & Target.Address & ")") > 1 Then
     MsgBox Target.Value & " is a duplicate entry. It will be removed.", vbExclamation, "Data Entry Editor"
     Target.Resize(1, 10).ClearContents
   End If
   
 End If

 End Sub

 

[sahal]

Try it like this.

Howard

Private Sub Worksheet_Change(ByVal Target As Range)

 If Target.Count > 1 Then Exit Sub
 If Target.Column = 3 And Len(Target.Value) > 0 Then

   If Evaluate("Countif(C:C," & Target.Address & ")") > 1 Then
     MsgBox Target.Value & " is a duplicate entry. It will be removed.", vbExclamation, "Data Entry Editor"
     Target.Resize(1, 10).ClearContents
   End If
   
 End If

 End Sub

Thank you for your attention.


And sorry it doesnt work, seems like the VBA code is not able to identify the duplicate value produced by the formula

 

[JLGWhiz]

See if this re-work of L.Howard's macro will work for you.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Count > 1 Then Exit Sub
 If Not Intersect(Target, Range("D:L")) Is Nothing Then
   If Evaluate("Countif(C:C," & Range("C" & Target.Row).Address & ")") > 1 Then
     MsgBox Target.Value & " is a duplicate entry. It will be removed.", vbExclamation, "Data Entry Editor"
     Range("D" & Target.Row).Resize(1, 9).ClearContents
   End If
 End If
 End Sub

 

[sahal]

Sorry dude.. its still not working
My sheet is almost similar to the one below. The first column generates codes with the help of Vlookup, I just need a macro to find the duplicates among these codes and if found delete the data from D:L of the same row, the only problem is that the macro which i have cannot find the duplicate codes generated by the formula, it can only find the duplicates if the values are entered in the first column.\


Any idea?

UNIQUE CODE GENERATOR	FIRST	SECOND	THIRD
123	APPLE	MANGO	SALAD
513	GRAPES	APPLE	SALAD
613	PEACH	APPLE	SALAD
516	GRAPES	APPLE	PEACH
123	APPLE	MANGO	SALAD
516	GRAPES	APPLE	PEACH

<tbody>
</tbody>

Thanks in advance!!

 

[JLGWhiz]

Let's go back to basics then.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("D:L")) Is Nothing Then
        If Application.CountIf(Range("C:C"), Range("C" & Target.Row).Value) > 1 Then
            MsgBox Cells(Target.Row, 3) & " is a duplicate value. Your entry will be removed.", vbExclamation, "Data Entry Editor"
            Range("D" & Target.Row).Resize(1, 9).ClearContents
        End If
End If
Application.EnableEvents = True
End Sub

This code looks at the value in column C when an entry is made in columns D:L, If duplicate values are found in column C, then any entries in columns D:L will be cleared. The code was tested and ran without error. It is event code for the worksheet change event and should be installed in the worksheet code module of the sheet where your data resides.

 

[sahal]

Let's go back to basics then.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("D:L")) Is Nothing Then
        If Application.CountIf(Range("C:C"), Range("C" & Target.Row).Value) > 1 Then
            MsgBox Cells(Target.Row, 3) & " is a duplicate value. Your entry will be removed.", vbExclamation, "Data Entry Editor"
            Range("D" & Target.Row).Resize(1, 9).ClearContents
        End If
End If
Application.EnableEvents = True
End Sub

This code looks at the value in column C when an entry is made in columns D:L, If duplicate values are found in column C, then any entries in columns D:L will be cleared. The code was tested and ran without error. It is event code for the worksheet change event and should be installed in the worksheet code module of the sheet where your data resides.

Thanks to JLGWhiz and L. Howard !! It worked fine without any error!
You guys are awesome!