Conditional Formatting in VBA

Question

I am tying to manage duplicates on an Excel sheet by having the duplicate cells turn red. I put this in a use to sheet protection to keep from editing the conditional formatting for these columns. However, when I move the cell information (by clicking and dragging) the conditional formatting moves from that cell as well. At the end of the day, I do not have duplicate coverage for every cell that I want. Is there some way I can prevent this from happening when I move the cell, or what macro can I put in to take care of this?

I want to do something like this using VBA:

Sub Duplicate()
Dim rngData As Range
Dim cell As Range

Set rngData = Range("P3:P19, P56:P58, P39:P42, P21:P25, P27:P37, P39:P42, P39:P42, P44:P54, M25:M76, B69:B77, B66:E67, B51:B64, H44:H47, D44:D47, H42, H33:H40, D33:D42, H31, D28:D31, H28:H29, D5:D8" & Cells(Rows.Count, "B").End(xlUp).Row)
For Each cell In rngData
cell.Offset(0, 0).Font.Color = vbBlack          ' DEFAULT COLOR
' LOCATE DUPLICATE VALUE(S) IN THE SPECIFIED RANGE OF DATA.
        If Application.Evaluate("COUNTIF(" & rngData.Address & "," & cell.Address & ")") > 1 Then
            cell.Offset(0, 0).Font.Color = vbRed        ' CHANGE FONT COLOR TO RED.
        End If
    Next cell

    Set rngData = Nothing

    Application.ScreenUpdating = True
End Sub

But I get a "Type Mismatch" error at: If Application.Evaluate("COUNTIF(" & rngData.Address & "," & cell.Address & ")") > 1 Then

How can I get around this?

The issue is you cannot use a disjointed range in Countif(). So you need to set the rngdata part to the extents as in this case B3:P81. — Scott Craner
– Scott Craner, Commented Mar 16, 2016 at 20:35
there are some other items in that region that are duplicates that I do not want highlighted... how else can I get around this? — Kish
– Kish, Commented Mar 16, 2016 at 20:38
Yes you can set a double loop through the data testing whether it is equal or not,and not use the countif. — Scott Craner
– Scott Craner, Commented Mar 16, 2016 at 20:44

Scott Craner · Accepted Answer · 2016-03-16 21:57:44Z

1

As per comment you would need to loop twice:

Sub Duplicate()
Dim rngData As Range
Dim cell As Range
Dim cell2 As Range

Set rngData = Range("P3:P19, P56:P58, P39:P42, P21:P25, P27:P37, P39:P42, P39:P42, P44:P54, M25:M76, B69:B77, B66:E67, B51:B64, H44:H47, D44:D47, H42, H33:H40, D33:D42, H31, D28:D31, H28:H29, D5:D8" & Cells(Rows.Count, "B").End(xlUp).Row)

rngData.Font.Color = vbBlack

For Each cell In rngData
    If cell.Font.Color = vbBlack Then
        For Each cell2 In rngData
            If cell = cell2 And cell.Address <> cell2.Address Then
                cell.Font.Color = vbRed
                cell2.Font.Color = vbRed
            End If
        Next
    End If
Next


Set rngData = Nothing

Application.ScreenUpdating = True
End Sub

edited Mar 16, 2016 at 21:57

answered Mar 16, 2016 at 20:57

Scott Craner

153k10 gold badges52 silver badges88 bronze badges

Sign up to request clarification or add additional context in comments.

5 Comments

Kish Over a year ago

This is setting every cell in the range to have a red font color, changing it from black. It is not checking the duplicates.

Scott Craner Over a year ago

@Kish see edit, I forgot to exclude itself when looking for duplicates.

Kish Over a year ago

It works! There is one small issue. When I type in a new cell within the range, it automatically turn red even if there is no, unless I run the macro again then it corrects itself. I would like for it to stay black in the first instance and show up red only when it is a duplicate-- after running the macro

Scott Craner Over a year ago

That is a different question but the quick answer is call this sub from a worksheet change event.

Kish Over a year ago

OK, I will post it separately since I need help with the code.

Collectives™ on Stack Overflow

Conditional Formatting in VBA

1 Answer 1

5 Comments

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

5 Comments

Related