Alert Duplicate Data

Vanda_a

Well-known Member
Joined
Oct 29, 2012
Messages
930
Dear all.

I have this code

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim myRange As Range, myCell As Range
Dim EntValue
Dim NewValue As Double, iMult As Double
Dim rCount As Long, iCount As Long, tCol As Long, myValueCount As Long
tCol = Target.Column
iCount = Empty
On Error Resume Next
iCount = Selection.Count
On Error GoTo 0
If iCount = 1 Then
If tCol = 1 Then
         Set myRange = Columns(Target.Column)
        If Not Application.Intersect(myRange, Range(Target.Address)) Is Nothing Then
            Set myCell = Range(Target.Address)
            EntValue = myCell.Value
            myValueCount = Application.WorksheetFunction.CountIf(myRange, EntValue)
            If myValueCount > 1 Then
                MsgBox "you have already enter " & EntValue & " at this column"
            End If
        End If
         ElseIf tCol = 2 Then
         Set myRange = Columns(Target.Column)
        If Not Application.Intersect(myRange, Range(Target.Address)) Is Nothing Then
            Set myCell = Range(Target.Address)
            EntValue = myCell.Value
            myValueCount = Application.WorksheetFunction.CountIf(myRange, EntValue)
            If myValueCount > 1 Then
                myCell.Interior.ColorIndex = 3
            End If
        End If
End If
End If
rCount = Application.WorksheetFunction.CountA(Range(Target.Address))
If rCount = 0 Then Range(Target.Address).Interior.ColorIndex = 0
Application.EnableEvents = True
End Sub
It alerts me my duplicate data. I works well for me. But now I have new case.

I would like it to alert me even though there is a few words duplicate.
Ex: A1 is I go to school. Then if A2 is I go to school. the code alert me.

Require change. A1 Buy apple SE00012. A2 SE00012 Purchase apple. I would like it to alert me too even though the date are not duplicate.

SE, SI, AE, AI, LE & LI. those are data I would like the code to check it there is a duplicate

Thank you
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

Sayre

Board Regular
Joined
Apr 12, 2005
Messages
180
Here's a simple addition to your code in a couple of spots that should do the job.

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim myRange As Range, myCell As Range
Dim EntValue
Dim NewValue As Double, iMult As Double
Dim rCount As Long, iCount As Long, tCol As Long, myValueCount As Long

Dim strTitle As String

tCol = Target.Column
iCount = Empty
On Error Resume Next
iCount = Selection.Count
On Error GoTo 0
If iCount = 1 Then
If tCol = 1 Then
         Set myRange = Columns(Target.Column)
        If Not Application.Intersect(myRange, Range(Target.Address)) Is Nothing Then
            Set myCell = Range(Target.Address)
            EntValue = myCell.Value
            
''''''''''''''''' my addition begins here
 
            If EntValue Like "*" & "SE" & "*" Then EntValue = "*" & "SE" & "*"
            If EntValue Like "*" & "SI" & "*" Then EntValue = "*" & "SI" & "*"
            If EntValue Like "*" & "AE" & "*" Then EntValue = "*" & "AE" & "*"
            If EntValue Like "*" & "AI" & "*" Then EntValue = "*" & "AI" & "*"
            If EntValue Like "*" & "LE" & "*" Then EntValue = "*" & "LE" & "*"
            If EntValue Like "*" & "LI" & "*" Then EntValue = "*" & "LI" & "*"
            
''''''''''''''''' my addition ends here            
           
            myValueCount = Application.WorksheetFunction.CountIf(myRange, EntValue)
            If myValueCount > 1 Then
                MsgBox "you have already enter " & EntValue & " at this column"
        End If
    End If
         ElseIf tCol = 2 Then
         Set myRange = Columns(Target.Column)
        If Not Application.Intersect(myRange, Range(Target.Address)) Is Nothing Then
            Set myCell = Range(Target.Address)
            EntValue = myCell.Value

''''''''''''''''' my addition begins here

            If EntValue Like "*" & "SE" & "*" Then EntValue = "*" & "SE" & "*"
            If EntValue Like "*" & "SI" & "*" Then EntValue = "*" & "SI" & "*"
            If EntValue Like "*" & "AE" & "*" Then EntValue = "*" & "AE" & "*"
            If EntValue Like "*" & "AI" & "*" Then EntValue = "*" & "AI" & "*"
            If EntValue Like "*" & "LE" & "*" Then EntValue = "*" & "LE" & "*"
            If EntValue Like "*" & "LI" & "*" Then EntValue = "*" & "LI" & "*"
            
''''''''''''''''' my addition ends here

            myValueCount = Application.WorksheetFunction.CountIf(myRange, EntValue)
            If myValueCount > 1 Then
                myCell.Interior.ColorIndex = 3
            End If
        End If
End If
End If
rCount = Application.WorksheetFunction.CountA(Range(Target.Address))
If rCount = 0 Then Range(Target.Address).Interior.ColorIndex = 0
Application.EnableEvents = True
End Sub

Of course this won't work if these values also occur in other parts of the text or if not capitalized.
 

Vanda_a

Well-known Member
Joined
Oct 29, 2012
Messages
930
Here's a simple addition to your code in a couple of spots that should do the job.

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim myRange As Range, myCell As Range
Dim EntValue
Dim NewValue As Double, iMult As Double
Dim rCount As Long, iCount As Long, tCol As Long, myValueCount As Long

Dim strTitle As String

tCol = Target.Column
iCount = Empty
On Error Resume Next
iCount = Selection.Count
On Error GoTo 0
If iCount = 1 Then
If tCol = 1 Then
         Set myRange = Columns(Target.Column)
        If Not Application.Intersect(myRange, Range(Target.Address)) Is Nothing Then
            Set myCell = Range(Target.Address)
            EntValue = myCell.Value
            
''''''''''''''''' my addition begins here
 
            If EntValue Like "*" & "SE" & "*" Then EntValue = "*" & "SE" & "*"
            If EntValue Like "*" & "SI" & "*" Then EntValue = "*" & "SI" & "*"
            If EntValue Like "*" & "AE" & "*" Then EntValue = "*" & "AE" & "*"
            If EntValue Like "*" & "AI" & "*" Then EntValue = "*" & "AI" & "*"
            If EntValue Like "*" & "LE" & "*" Then EntValue = "*" & "LE" & "*"
            If EntValue Like "*" & "LI" & "*" Then EntValue = "*" & "LI" & "*"
            
''''''''''''''''' my addition ends here            
           
            myValueCount = Application.WorksheetFunction.CountIf(myRange, EntValue)
            If myValueCount > 1 Then
                MsgBox "you have already enter " & EntValue & " at this column"
        End If
    End If
         ElseIf tCol = 2 Then
         Set myRange = Columns(Target.Column)
        If Not Application.Intersect(myRange, Range(Target.Address)) Is Nothing Then
            Set myCell = Range(Target.Address)
            EntValue = myCell.Value

''''''''''''''''' my addition begins here

            If EntValue Like "*" & "SE" & "*" Then EntValue = "*" & "SE" & "*"
            If EntValue Like "*" & "SI" & "*" Then EntValue = "*" & "SI" & "*"
            If EntValue Like "*" & "AE" & "*" Then EntValue = "*" & "AE" & "*"
            If EntValue Like "*" & "AI" & "*" Then EntValue = "*" & "AI" & "*"
            If EntValue Like "*" & "LE" & "*" Then EntValue = "*" & "LE" & "*"
            If EntValue Like "*" & "LI" & "*" Then EntValue = "*" & "LI" & "*"
            
''''''''''''''''' my addition ends here

            myValueCount = Application.WorksheetFunction.CountIf(myRange, EntValue)
            If myValueCount > 1 Then
                myCell.Interior.ColorIndex = 3
            End If
        End If
End If
End If
rCount = Application.WorksheetFunction.CountA(Range(Target.Address))
If rCount = 0 Then Range(Target.Address).Interior.ColorIndex = 0
Application.EnableEvents = True
End Sub

Of course this won't work if these values also occur in other parts of the text or if not capitalized.

Great...... It works so well. Thank you very much
 

Sayre

Board Regular
Joined
Apr 12, 2005
Messages
180
Great. Be careful with it though. There is risk of false alerts or of not receiving alerts when you want them, especially if the data is entered by hand.

example: If the text you mentioned above was this: A2 SI00012 PURCHASE APPLE, you would get a false alert.
Or if it was entered as A2 se00012 purchase apple, then the code will fail to alert properly.

You'd need a lot more code to account for all the scenarios that may come up. Just fyi!
 

Vanda_a

Well-known Member
Joined
Oct 29, 2012
Messages
930

ADVERTISEMENT

Great. Be careful with it though. There is risk of false alerts or of not receiving alerts when you want them, especially if the data is entered by hand.

example: If the text you mentioned above was this: A2 SI00012 PURCHASE APPLE, you would get a false alert.
Or if it was entered as A2 se00012 purchase apple, then the code will fail to alert properly.

You'd need a lot more code to account for all the scenarios that may come up. Just fyi!

Oh... I see. So better keying capital letter for SE or SI. so there will not be a false alert :)

Tested "purchaSE". There is a false alert :D. beside SE or SI, better uncapital them

Thank you very much
 
Last edited:

Vanda_a

Well-known Member
Joined
Oct 29, 2012
Messages
930
I have tested it. False alert with my demand.

Ex: I buy apple SE0001. Then I go to school SE0002. It alerts me @_@. SE0001 & SE0002 are different.

Please help
 
Last edited:

Sayre

Board Regular
Joined
Apr 12, 2005
Messages
180

ADVERTISEMENT

OK, I suspected there might be more to it.
Do you have a list of all these string values you need it to search for? Or do you only know that they begin with "SE", "SI", etc.... If you have a list it will be easier.
 

Vanda_a

Well-known Member
Joined
Oct 29, 2012
Messages
930
OK, I suspected there might be more to it.
Do you have a list of all these string values you need it to search for? Or do you only know that they begin with "SE", "SI", etc.... If you have a list it will be easier.
I just know they begin with SE SI then numbers
 

Sayre

Board Regular
Joined
Apr 12, 2005
Messages
180
If that's the case it may be easier to see if you can change the format of entry onto your sheet rather than to modify your script to parse through each string that starts with "SE", SI", etc.... If you can have the values SE0001, SE0002, SI0001, etc... isolated by themselves in Column A, and the rest of your comments in another column, this will be much simpler to solve. If that cannot be done, I'll need to search for proper code to do this myself or perhaps someone more knowledgeable can help? I believe a google search on functions like Len, Left, & Mid will take you down the right path. I could probably use more experience with those functions myself but cannot take the time today to research. I'll get back to this if I get some time later. Sorry I could not be more help!
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,604
Messages
5,838,332
Members
430,538
Latest member
PedroOliveira

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top