adjusting code highlight duplicated names without nickname

[abdelfattah]

hi,
i have this code but not work as what i want i would highlight only repeated names without nickname in column c
it supposes this result

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Row = 1 Then Exit Sub             ' IF ITS A HEADER, DO NOTHING.
    
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    
    Dim myDataRng As Range
    Dim cell As Range
    
    ' WE WILL SET THE RANGE (SECOND COLUMN).
    Set myDataRng = Range("c1:c" & Cells(Rows.Count, "c").End(xlUp).Row)
    
    For Each cell In myDataRng
        cell.Offset(0, 0).Font.Color = vbBlack          ' DEFAULT COLOR.
    
        ' LOCATE DUPLICATE VALUE(S) IN THE SPECIFIED.
        If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
            cell.Offset(0, 0).Font.Color = vbRed        ' CHANGE COLOR TO RED.
        End If
    Next cell
    
    Set myDataRng = Nothing
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

Sorry, but every time you put an example you change it, so I can't guess what you need.

 

[abdelfattah]

first image is right code works that my first demmend and the image 2 i told you ignore it now i would tweak as in existed in image 3 just highlight the firs three words are repeated

 

[DanteAmor]

first image is right code works that my first demmend and the image 2 i told you ignore it now i would tweak as in existed in image 3 just highlight the firs three words are repeated

Sorry, but I don't understand the scope.
You only want to highlight when you have 4 names in the cell, as is the example in the post #9?

 

[abdelfattah]

yes , the same post #9

 

[DanteAmor]

yes , the same post #9

Please, try this

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c As Range, dic As Object, rng As Range, chn As Range
  Dim sNms As Variant, a_b As String, i As Long
  
  Set chn = Intersect(Target, Range("C:C"))
  
  If Not Intersect(Target, Range("C:C")) Is Nothing Then
    Set rng = Range("C1", Range("C" & Rows.Count).End(3))
    Set dic = CreateObject("Scripting.Dictionary")
    dic.comparemode = vbTextCompare
    rng.Font.Bold = True
    rng.Font.ColorIndex = xlAutomatic
    For Each c In rng
      sNms = Split(c, " ")
      a_b = ""
      If UBound(sNms) = 2 Or UBound(sNms) = 3 Then
        a_b = Trim(sNms(0) & " " & sNms(1) & " " & sNms(2))
        If Not dic.exists(a_b) Then
          If UBound(sNms) = 3 Then
            dic(a_b) = c.Row
          End If
        Else
          c.Characters(1, Len(a_b)).Font.Color = vbRed
          Range("C" & dic(a_b)).Characters(1, Len(a_b)).Font.Color = vbRed
        End If
      End If
    Next c
  End If
End Sub

 

[abdelfattah]

good job , dante now it works thanks so much

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.