Maybe that helps ... if not please ignore it
Visual Basic-Quellcode
Option Explicit
Sub DoubleValues ()
Dim Finden As Range
Dim r As Range
Dim i As Long
Dim RngZahlen As Range
Dim RngZahlenAbs As Range
Set RngZahlen = Range("H1", Range("H1").End(xlDown))
Set RngZahlenAbs = Range("I1", Range("I1").End(xlDown))
'Auxiliary column I with absolute values
For Each r In RngZahlen
r.Offset(0, 1) = Abs(r)
Next r
'' Color index from 3, since 1 black and 2 white
i = 3
'Determine duplicate values and mark with a continuous color index
For Each r In RngZahlenAbs
If WorksheetFunction.CountIf(RngZahlenAbs, r) > 1 Then
Set Finden = RngZahlenAbs.Find(r, r)
r.offset(0,-1).Interior.ColorIndex = i
Finden.offset(0,-1).Interior.ColorIndex = i
End If
i = i + 1
Next r
End Sub
I would be happy to find out if I could help.
Nikolino
I know I don't know anything (Socrates)