Alert Duplicate Data

Vanda_a

Well-known Member
Joined
Oct 29, 2012
Messages
923
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
 

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

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
923
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
923

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
923
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
923
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!
 

Watch MrExcel Video

Forum statistics

Threads
1,109,541
Messages
5,529,437
Members
409,877
Latest member
DDhol
Top