Excel: Alert Duplicate Data


Dear all. I have this 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


This question generated 23 answers. To proceed to the answers, click here.

This thread is current as of September 09, 2014.


For more resources for Microsoft Excel