Alert Duplicate Data

V

Vanda_a

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

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Sort by date Sort by votes
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.
 
Upvote 0
Sayre said:
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.
Click to expand...

Great...... It works so well. Thank you very much
 
Upvote 0
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!
 
Upvote 0
Sayre said:
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!
Click to expand...

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:
Upvote 0
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:
Upvote 0
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.
 
Upvote 0
Sayre said:
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.
Click to expand...
I just know they begin with SE SI then numbers
 
Upvote 0
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!
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Need to have Worksheet_Change event include value from another column using structured reference
Replies
4
Views
295
Alex Blakenburg
A
S
  • Solved
Need value to be the Table Column Header in lieu of Cell Address
Replies
1
Views
269
sspatriots
S
A
  • Question
Moving Rows Up (Scroll) To Defined Row Number for Viewing
Replies
6
Views
183
Ark68
A
A
  • Question
After User Enters A Value (Validation List), Not Automatically Advancing To Next Cell As Per "Select"
Replies
1
Views
164
Ark68
A
I
  • Question
Modify VBA script to count rows with data in multiple sheets
Replies
0
Views
74
irishjsk
I

Forum statistics

Threads
1,214,523
Messages
6,120,034
Members
448,940
Latest member
mdusw

Share this page

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
Back
Top