repérer les doublons en VBA....à partir de la Cellule active

Sub test()
Dim Pl As Range, c As Range
Set Pl = ActiveCell.CurrentRegion
Pl.Interior.ColorIndex = none
For Each c In Pl
    If c Like ActiveCell.Value Then c.Interior.ColorIndex = 7
Next c
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.Calculate
End Sub

Cells.FormatConditions.Delete 'RAZ

Cells.FormatConditions.Delete 
Cells.ClearComments

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Range("B4:E10")
     .FormatConditions.Delete
    .ClearComments
End With
  
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target = "" Then Exit Sub
Dim n&, v, a1$, a2$
Cancel = True
With Range("B4:E10")
    n = Application.CountIf(.Cells, ActiveCell)
  '-------------MEFC
    If n > 1 Then
            v = Val(Application.Version)
            a1 = IIf(v > 12, .Cells(1), ActiveCell).Address(0, 0) 'reférence relative
            a2 = ActiveCell.Address 'référence absolue
            .FormatConditions.Add xlExpression, _
            Formula1:="=(" & a1 & "<>"""")*(" & a1 & "=" & a2 & ")"
            .FormatConditions(1).Interior.Color = vbYellow 'jaune
    End If
    ' -------------------------commentaire
    With ActiveCell.AddComment(IIf(n = 1, "valeur unique", n & " doublons"))
            With .Shape.TextFrame
                .Parent.Fill.ForeColor.RGB = vbBlack 'fond noir
                .Characters.Font.Size = 11
                .Characters.Font.ColorIndex = 2 'blanc
                .Characters.Font.Bold = True 'gras
                .AutoSize = True
            End With
            .Visible = True
    End With
  
End With
End Sub

Cancel = True
With Range("B4:E10")
    .FormatConditions.Delete
    .ClearComments