excel duplicate cells

%3CLINGO-SUB%20id%3D%22lingo-sub-1523541%22%20slang%3D%22en-US%22%3Eexcel%20duplicate%20cells%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1523541%22%20slang%3D%22en-US%22%3E%3CP%3EHello%20Everybody%3C%2FP%3E%3CP%3EI%20want%20to%20find%20duplicate%20cells%20and%20fill%20them%20with%20different%20colors%2C%20I%20mean%20each%20pair%20of%20duplicate%20cells%20be%20filled%20with%20a%20color%20different%20from%20the%20other%20pairs%2C%20but%20when%20I%20use%20conditional%20formatting%2C%20all%20duplicate%20cells%20turn%20into%20same%20color(for%20example%20red).%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1523541%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EFormulas%20and%20Functions%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1523673%22%20slang%3D%22en-US%22%3EBetreff%3A%20excel%20duplicate%20cells%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1523673%22%20slang%3D%22en-US%22%3EMaybe%20that%20helps%20...%20if%20not%20please%20ignore%20it%3CBR%20%2F%3E%3CBR%20%2F%3EVisual%20Basic-Quellcode%3CBR%20%2F%3E%3CBR%20%2F%3EOption%20Explicit%3CBR%20%2F%3ESub%20DoubleValues%20()%3CBR%20%2F%3EDim%20Finden%20As%20Range%3CBR%20%2F%3EDim%20r%20As%20Range%3CBR%20%2F%3EDim%20i%20As%20Long%3CBR%20%2F%3EDim%20RngZahlen%20As%20Range%3CBR%20%2F%3EDim%20RngZahlenAbs%20As%20Range%3CBR%20%2F%3E%3CBR%20%2F%3ESet%20RngZahlen%20%3D%20Range(%22H1%22%2C%20Range(%22H1%22).End(xlDown))%3CBR%20%2F%3ESet%20RngZahlenAbs%20%3D%20Range(%22I1%22%2C%20Range(%22I1%22).End(xlDown))%3CBR%20%2F%3E%3CBR%20%2F%3E'Auxiliary%20column%20I%20with%20absolute%20values%3CBR%20%2F%3EFor%20Each%20r%20In%20RngZahlen%3CBR%20%2F%3Er.Offset(0%2C%201)%20%3D%20Abs(r)%3CBR%20%2F%3ENext%20r%3CBR%20%2F%3E%3CBR%20%2F%3E''%20Color%20index%20from%203%2C%20since%201%20black%20and%202%20white%3CBR%20%2F%3Ei%20%3D%203%3CBR%20%2F%3E%3CBR%20%2F%3E'Determine%20duplicate%20values%20and%20mark%20with%20a%20continuous%20color%20index%3CBR%20%2F%3EFor%20Each%20r%20In%20RngZahlenAbs%3CBR%20%2F%3E%3CBR%20%2F%3EIf%20WorksheetFunction.CountIf(RngZahlenAbs%2C%20r)%20%26gt%3B%201%20Then%3CBR%20%2F%3ESet%20Finden%20%3D%20RngZahlenAbs.Find(r%2C%20r)%3CBR%20%2F%3E%3CBR%20%2F%3Er.offset(0%2C-1).Interior.ColorIndex%20%3D%20i%3CBR%20%2F%3EFinden.offset(0%2C-1).Interior.ColorIndex%20%3D%20i%3CBR%20%2F%3E%3CBR%20%2F%3EEnd%20If%3CBR%20%2F%3E%3CBR%20%2F%3Ei%20%3D%20i%20%2B%201%3CBR%20%2F%3E%3CBR%20%2F%3ENext%20r%3CBR%20%2F%3E%3CBR%20%2F%3EEnd%20Sub%3CBR%20%2F%3E%3CBR%20%2F%3EI%20would%20be%20happy%20to%20find%20out%20if%20I%20could%20help.%3CBR%20%2F%3E%3CBR%20%2F%3ENikolino%3CBR%20%2F%3EI%20know%20I%20don't%20know%20anything%20(Socrates)%3C%2FLINGO-BODY%3E
Occasional Visitor

Hello Everybody

I want to find duplicate cells and fill them with different colors, I mean each pair of duplicate cells be filled with a color different from the other pairs, but when I use conditional formatting, all duplicate cells turn into same color(for example red).

2 Replies
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)
PS Please change the columns ... was copied freihnad from the Internet