Dubbels zoeken

[verluc]

Met hulp van dit forum heb ik onderstaande werkende macro kunnen samenstellen.
Echter wil ik er nog iets aan toevoegen:
Na de box "er zijn dubbels" in te drukken verdwijnt ook de rode kleur van de dubbele cellen.
Het is de bedoeling dat deze gekleurd blijven, anders kan men deze niet meer zien.
Heeft iemand kennis om deze macro aan te passen?
Met mijn oprechte dank bij voorbaat;

Dim rB As Range
Dim bD As Boolean
    Set rB = Worksheets("Blad1").Range("A4:A1000")
    rB.Interior.ColorIndex = xlNone
    For Each c In rB
        If WorksheetFunction.CountIf(rB, c) > 1 Then
            c.Interior.Color = vbRed
            bD = True
        End If
    Next
    If bD = False Then
        UF1.Show
    Else
        MsgBox "Er zijn dubbels !!!", vbExclamation, "Dubbele waardes."
    End If

 

[Peekhamer]

Waarom doe je dat anders niet gewoon via Voorwaardelijke Opmaak?

Tabblad Start -> Voorwaardelijke Opmaak -> Markeringsregels voor Cellen -> Dubbele waarden

Deze doet wat je wilt:

Sub DubbeleWaarden()

    With Range("A4:A1000")
        .FormatConditions.AddUniqueValues
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).DupeUnique = xlDuplicate
        .FormatConditions(1).Font.Color = -16383844
        .FormatConditions(1).Interior.Color = 13551615
        .FormatConditions(1).StopIfTrue = False
    End With
End Sub

Edit; dit is overigens gewoon Macro-Recorder-code die iets is aangepast.

Moet die Range vast blijven, als harde verwijzing?

 

[verluc]

Werkt zoals gewenst. Zeer bedankt

 

[verluc]

Range mag ook zijn : A4 tot laatste ingevulde cel van kolom A

 

[snb]

Mag van mij ook