excel duplicate cells

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)