Highlight duplicate entry if 3 columns data are the same

[carlrubber]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Row = 1 Then Exit Sub            
    
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    
    Dim myDataRng As Range
    Dim myDataRng1 As Range
    Dim myDataRng2 As Range
    Dim cell As Range
     
    ' SET THE RANGE (SECOND COLUMN).
    Set myDataRng = Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
     Set myDataRng1 = Range("C1:C" & Cells(Rows.Count, "B").End(xlUp).Row)
      Set myDataRng2 = Range("D1:D" & Cells(Rows.Count, "B").End(xlUp).Row)
     
    For Each cell In myDataRng
        cell.Offset(0, 0).Font.Color = vbBlack          ' DEFAULT COLOR.
    
        ' LOCATE DUPLICATE VALUE(S) IN THE SPECIFIED RANGE OF DATA.
        If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
        If Application.Evaluate("COUNTIF(" & myDataRng1.Address & "," & Cells(Target.Row, 3).Address & ")") > 1 Then
        If Application.Evaluate("COUNTIF(" & myDataRng2.Address & "," & Cells(Target.Row, 4).Address & ")") > 1 Then
            cell.Offset(0, 0).Font.Color = vbRed        ' CHANGE FORE COLOR TO RED.
        End If
        End If
        End If
    
    Next cell
     
    Set myDataRng = Nothing
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

I would like to highlight the record that column B C D are exactly the same, but the code show the result, can anyone help?pls

A	B	C	D	E
	aa	bb	cc
	bb	bb	cc
	bb	bb	cc
	bb	dd	ff

<tbody>
</tbody>

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG14Dec03
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Txt = Dn.Value & Dn.Offset(, 1) & Dn.Offset(, 2)
    [COLOR="Navy"]If[/COLOR] Not .Exists(Txt) [COLOR="Navy"]Then[/COLOR]
        .Add Txt, Dn
    [COLOR="Navy"]Else[/COLOR]
        .Item(Txt).Resize(, 3).Font.Color = vbRed
        Dn.Resize(, 3).Font.Color = vbRed
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[carlrubber]

um... would use worksheet_change to do please?

 

[MickG]

Try this:-

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]If[/COLOR] Not Intersect(rng.Resize(, 3), Target) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
    rng.Resize(, 3).Font.Color = vbBlack
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] rng
    Txt = Dn.Value & Dn.Offset(, 1) & Dn.Offset(, 2)
    [COLOR="Navy"]If[/COLOR] Not .exists(Txt) [COLOR="Navy"]Then[/COLOR]
        .Add Txt, Dn
    [COLOR="Navy"]Else[/COLOR]
        .Item(Txt).Resize(, 3).Font.Color = vbRed
        Dn.Resize(, 3).Font.Color = vbRed
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[carlrubber]

thz Mick, have a try later and get back to you soon but would you give some explanation as i m new in vba

 

[MickG]

To load code:-
Right Click Data sheet tab, Select "View Code", Vbwindow appears.
Paste the code into the Vbwindow, Close Vbwindow

To run code:-
Change any value in columns "A B or C"
Duplicate rows Font colours are changes to red.