Highlight Duplicates with Alternate Colors

[madhuchelliah]

Hello i have data from column A to BG, i want to check duplicates based on values in columns R, AH, AJ, AN and AO. Row range is dyanmic one. If the mentioned columns values are duplicated, the VBA has to highlight the entire rows with a color. Similarly next set of duplicates has to be highlighted with another color. Next set with same as first color and so on. Data listed in ascending order so duplicates are always in next rows it wont exist in anywhere else. refer the example for more info. If the data in the mentioned column has no duplicates then leave it as it is. It has to highlight only the duplicated rows. If the color is in RGB format i can change later if required. Thank you.

Book1.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP	AQ	AR	AS	AT	AU	AV	AW	AX	AY	AZ	BA	BB	BC	BD	BE	BF	BG
1	Header1	Header2	Header3	Header4	Header5	Header6	Header7	Header8	Header9	Header10	Header11	Header12	Header13	Header14	Header15	Header16	Header17	Header18	Header19	Header20	Header21	Header22	Header23	Header24	Header25	Header26	Header27	Header28	Header29	Header30	Header31	Header32	Header33	Header34	Header35	Header36	Header37	Header38	Header39	Header40	Header41	Header42	Header43	Header44	Header45	Header46	Header47	Header48	Header49	Header50	Header51	Header52	Header53	Header54	Header55	Header56	Header57	Header58	Header59
2																		AAA	e															BBB		CCC				CCC	DDD
3																		AAA						e								e		BBB		CCC				CCC	DDD
4																		AAA			r					e								BBB		CCC				CCC	DDD
5																		BBB											g					CCC		DDD				EEE	FFF
6																		GGG	r															HHH		III				JJJ	KKK
7																		GGG	r															HHH		III				JJJ	KKK
8																		HHH																III		JJJ				KKK	LLL
9																		HHH																III		JJJ				KKK	LLL
10																		MMM																NNN		OOO				PPP	QQQ
11																		NNN																PPP		QQQ				RRR	SSS
12																		NNN																PPP		QQQ				RRR	SSS
Sheet4

 

[Legacy 143009]

Hello i have data from column A to BG, i want to check duplicates based on values in columns R, AH, AJ, AN and AO. Row range is dyanmic one. If the mentioned columns values are duplicated, the VBA has to highlight the entire rows with a color. Similarly next set of duplicates has to be highlighted with another color. Next set with same as first color and so on. Data listed in ascending order so duplicates are always in next rows it wont exist in anywhere else. refer the example for more info. If the data in the mentioned column has no duplicates then leave it as it is. It has to highlight only the duplicated rows. If the color is in RGB format i can change later if required. Thank you.

Book1.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP	AQ	AR	AS	AT	AU	AV	AW	AX	AY	AZ	BA	BB	BC	BD	BE	BF	BG
1	Header1	Header2	Header3	Header4	Header5	Header6	Header7	Header8	Header9	Header10	Header11	Header12	Header13	Header14	Header15	Header16	Header17	Header18	Header19	Header20	Header21	Header22	Header23	Header24	Header25	Header26	Header27	Header28	Header29	Header30	Header31	Header32	Header33	Header34	Header35	Header36	Header37	Header38	Header39	Header40	Header41	Header42	Header43	Header44	Header45	Header46	Header47	Header48	Header49	Header50	Header51	Header52	Header53	Header54	Header55	Header56	Header57	Header58	Header59
2																		AAA	e															BBB		CCC				CCC	DDD
3																		AAA						e								e		BBB		CCC				CCC	DDD
4																		AAA			r					e								BBB		CCC				CCC	DDD
5																		BBB											g					CCC		DDD				EEE	FFF
6																		GGG	r															HHH		III				JJJ	KKK
7																		GGG	r															HHH		III				JJJ	KKK
8																		HHH																III		JJJ				KKK	LLL
9																		HHH																III		JJJ				KKK	LLL
10																		MMM																NNN		OOO				PPP	QQQ
11																		NNN																PPP		QQQ				RRR	SSS
12																		NNN																PPP		QQQ				RRR	SSS
Sheet4

Will duplicate rows always be consecutive? (one after another)

 

[madhuchelliah]

Will duplicate rows always be consecutive? (one after another)

Yes..

 

[Legacy 143009]

One last question, should all row content match?

I mean what if AH2=JJJ, AH3=JJJ but AJ2=CCC, AJ3=KKK? I mean AH rows are matching but AJ rows not. Is it a match?
Or should all R, AH, AJ, AN and AO match at the same time?

 

[madhuchelliah]

I mean what if AH2=JJJ, AH3=JJJ but AJ2=CCC, AJ3=KKK? I mean AH rows are matching but AJ rows not. Is it a match?
Or should all R, AH, AJ, AN and AO match at the same time?

Hey, All the columns R, AH, AJ, AN and AO should match at same time. If even one column data is not matching then no need to consider it as duplicate. Hope it helps.

 

[Legacy 143009]

Then this will work for you:

Sub test()
  Dim myRange As Variant, colour As String
  
  colour = "Grey"
  myRange = Intersect(ActiveSheet.UsedRange, Range("A:AO"))
  ReDim Preserve myRange(1 To UBound(myRange), 1 To UBound(myRange, 2) + 1)
  
  For r = 2 To UBound(myRange) - 1
    If myRange(r + 1, 18) = myRange(r, 18) And myRange(r + 1, 34) = myRange(r, 34) And myRange(r + 1, 36) = myRange(r, 36) And myRange(r + 1, 40) = myRange(r, 40) And myRange(r + 1, 41) = myRange(r, 41) Then
      myRange(r, UBound(myRange, 2)) = colour
      myRange(r + 1, UBound(myRange, 2)) = colour
    Else
      colour = IIf(colour = "Grey", "Blue", "Grey")
    End If
  Next
  
  For i = 2 To UBound(myRange)
    Select Case myRange(i, UBound(myRange, 2))
    Case "Grey"
      Rows(i).Interior.Color = RGB(166, 166, 166)
    Case "Blue"
      Rows(i).Interior.Color = RGB(142, 169, 219)
    End Select
  Next
End Sub

 

[Legacy 143009]

A slightly more efficient version could be:

Sub test()
  Dim myRange As Variant, colour As String
 
  colour = RGB(166, 166, 166)
  myRange = Intersect(ActiveSheet.UsedRange, Range("A:AO"))
  ReDim Preserve myRange(1 To UBound(myRange), 1 To UBound(myRange, 2) + 1)
 
  For r = 2 To UBound(myRange) - 1
    If myRange(r + 1, 18) = myRange(r, 18) And myRange(r + 1, 34) = myRange(r, 34) And myRange(r + 1, 36) = myRange(r, 36) And myRange(r + 1, 40) = myRange(r, 40) And myRange(r + 1, 41) = myRange(r, 41) Then
      myRange(r, UBound(myRange, 2)) = colour
      myRange(r + 1, UBound(myRange, 2)) = colour
    Else
      colour = IIf(colour = RGB(166, 166, 166), RGB(142, 169, 219), RGB(166, 166, 166))
      myRange(r + 1, UBound(myRange, 2)) = xlNone
    End If
  Next
 
  For i = 2 To UBound(myRange)
    Rows(i).Interior.Color = myRange(i, UBound(myRange, 2))
  Next
End Sub

 

[kevin9999]

This is nowhere near as neat and tidy as @Flashbond 's version, but I think it does the alternative colouring closer to what you wanted in your original post?

Option Explicit
Sub AltColors()
    Dim Col_One As Long, Col_Two As Long
    Col_One = RGB(208, 208, 206)
    Col_Two = RGB(132, 151, 176)
    
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<~~ change to actual sheet name
    ws.UsedRange.Offset(1).Interior.Color = xlNone
    
    Dim LCol As Long, LRow As Long
    LCol = ws.Cells.Find("*", , xlFormulas, , 2, 2).Column + 1
    LRow = ws.Cells(Rows.Count, "R").End(xlUp).Row
    
    Dim i As Long, z As Long, ArrIn, ArrOut
    z = 1
    ArrIn = ws.Range("R2:R" & LRow + 1)
    ReDim ArrOut(1 To UBound(ArrIn, 1), 1 To 1)
    
    If ArrIn(1, 1) = ArrIn(2, 1) Then ArrOut(1, 1) = z
    For i = 2 To UBound(ArrIn, 1) - 1
        If ArrIn(i, 1) = ArrIn(i - 1, 1) Or ArrIn(i, 1) = ArrIn(i + 1, 1) Then
            If ArrIn(i, 1) <> ArrIn(i - 1, 1) Then
                If z = 1 Then z = 2 Else z = 1
            End If
            ArrOut(i, 1) = z
        End If
    Next i
    ws.Cells(2, LCol).Resize(UBound(ArrOut, 1)).Value = ArrOut
    
    Dim c As Range
    For Each c In ws.Range(ws.Cells(2, LCol), ws.Cells(LRow, LCol))
        Select Case c.Value
            Case Is = 1
                c.Offset(, -(LCol - 1)).Resize(, 59).Interior.Color = Col_One
            Case Is = 2
                c.Offset(, -(LCol - 1)).Resize(, 59).Interior.Color = Col_Two
        End Select
    Next c
    ws.Columns(LCol).EntireColumn.ClearContents
End Sub

 

[Legacy 143009]

This is nowhere near as neat and tidy as @Flashbond 's version,

And maybe even faster Just joking, I haven't tested. I don't care if its slower thanks for your nice compliments @kevin9999

For my code, another best practice would be to change colour variable type from String to Long, since RGB() value is a Long type.

Dim myRange As Variant, colour As Long