VBA to highlight duplicates in certain columns

[xsmurf]

I posted this on another excel forum (Ozgrid) but I have not received any responses as of now.
This forum has also helped me a lot over the years and I hope this will be the case now.

I know there are a lot of ways to show duplicates values in excel, but I have not seen this yet so I don't know if this is possible.
Let's say I have a range from C5 to X70, within that range I would like to see duplicates marked red.
But within that range there a columns and rows that need to be excluded from turning red (so duplicates are aloud in these columns & rows)
The code should only look for doubles in columns C / E / G / I / K / M / O
The code should ignore doubles in row 55 / 56 / 57 / 58

So if there is a name John in column C, but also a John in column K, both John's should highlight RED.
A John in row 56 should NOT turn RED, because this is aloud.


I want to use this with a Worksheet_Change event in VBA, and prefer not to use conditional formatting, because there will be a lot of copy & paste happing in this sheet.


Can anybody help me out with my problem?

A big thanks in advance for all the help that will be offered, I really appreciate it.

 

[kevin9999]

See if this does what you want:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rng As Range
    Set rng = Range("C5:C54,C59:C70,E5:E54,E59:E70,G5:G54,G59:G70,I5:I54,I59:I70,K5:K54,K59:K70,M5:M54,M59:M70,O5:O54,O59:O70")
    With rng
        .FormatConditions.Delete
        .FormatConditions.AddUniqueValues
        .FormatConditions(1).DupeUnique = xlDuplicate
        .FormatConditions(1).Font.Color = vbRed
    End With
End Sub

 

[kevin9999]

Sorry, should have been Worksheet_Change not Selection_Change (also reduced the code)

Private Sub Worksheet_Change(ByVal Target As Range)
    With Range("C5:C54,C59:C70,E5:E54,E59:E70,G5:G54,G59:G70,I5:I54,I59:I70,K5:K54,K59:K70,M5:M54,M59:M70,O5:O54,O59:O70")
        .FormatConditions.Delete
        .FormatConditions.AddUniqueValues
        .FormatConditions(1).DupeUnique = xlDuplicate
        .FormatConditions(1).Font.Color = vbRed
    End With
End Sub

 

[xsmurf]

@kevin9999 That seems to have done the trick, works like a charm. Thank you for you help.

As an extra would it be possible to exclude certain words ("ABSENT" & "VACATION") for being marked as doubles within that range?

 

[kevin9999]

@kevin9999 That seems to have done the trick, works like a charm. Thank you for you help.

As an extra would it be possible to exclude certain words ("ABSENT" & "VACATION") for being marked as doubles within that range?

Try this

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rng As Range, c As Range
    Set rng = Range("C5:C54,C59:C70,E5:E54,E59:E70,G5:G54,G59:G70,I5:I54,I59:I70,K5:K54,K59:K70,M5:M54,M59:M70,O5:O54,O59:O70")
    With rng
        .FormatConditions.Delete
        .FormatConditions.AddUniqueValues
        .FormatConditions(1).DupeUnique = xlDuplicate
        .FormatConditions(1).Font.Color = vbRed
    End With
    For Each c In rng
        If c.Value = "ABSENT" Or c.Value = "VACATION" Then
            c.FormatConditions.Delete
        End If
    Next c
End Sub

 

[Peter_SSs]

Try this to save looping through the 400+ cells individually to deal with those two particular values. Also skip reapplying the CF if no cells in the relevant range were changed.
I have assumed that the values are not formula-generated.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    
    Set rng = Range("C5:C54,C59:C70,E5:E54,E59:E70,G5:G54,G59:G70,I5:I54,I59:I70,K5:K54,K59:K70,M5:M54,M59:M70,O5:O54,O59:O70")
    If Not Intersect(Target, rng) Is Nothing Then
      With rng
          .FormatConditions.Delete
          
          .FormatConditions.Add Type:=xlExpression, Formula1:=Replace("=OR(#=""ABSENT"",#=""VACATION"")", "#", .Cells(1).Address(0, 0))
          .FormatConditions(1).SetFirstPriority
          .FormatConditions(1).StopIfTrue = True
          
          .FormatConditions.AddUniqueValues
          .FormatConditions(2).DupeUnique = xlDuplicate
          .FormatConditions(2).Font.Color = vbRed
      End With
    End If
End Sub

 

[xsmurf]

Both solutions work like a charm

Thank you @kevin9999 & @Peter_SSs for your help, much appreciated

 

[kevin9999]

Both solutions work like a charm

Thank you @kevin9999 & @Peter_SSs for your help, much appreciated

Glad we could help, and thanks for the feedback.