View Full Version : Conditional formating of rows

03-17-2011, 11:28 AM

I have data in cells A2 to K5000. I want to colour the entire rows based on criteria being met in column A.

As an example, letís assume the following values in the first few of rows in A2:A9:


I want to alternative row colours based on groups of cells as indentified by where consecutive rows contain the same values in column A.

So for instance I want to colour the first group of cells white (the 7s - a2:a3), the next set (the 12s) green, the next set white (just one row here - 4), the next set green (11s) etc for all groups in the entire range.

This is to help visually breakout the groups. Note the colour of the cell should not be conditional on the actual value of the cell, but by being in distinct different groups as indentified by immediate cells having the same value and the actual colour is not really important.

Anyone know how best to do this?



03-17-2011, 12:06 PM
this may help:


Option Explicit
Option Base 1

Sub color_same_data()
'Erik Van Geit
'051124 1754
'color cells with same contents in single column

Dim rng As Range
Dim LR As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim Arr As Variant
Dim ArrItem As String
Dim ArrRowNumbers() As Variant
Dim HL As Integer 'highlight

Const col = 1
Const FR = 2

If Cells(Rows.Count, col) <> "" Then LR = Rows.Count Else LR = Cells(Rows.Count, col).End(xlUp).Row
Set rng = Range(Cells(FR, col), Cells(LR, col))

Arr = rng.Value
i = 1
j = 1
ArrItem = Arr(i, 1)
k = i
On Error Resume Next 'avoids bug at the end of the loop "Arr(i, 1)" when i > UBound(arr)
i = i + 1
Loop While ArrItem = Arr(i, 1)
On Error GoTo 0
'If k <> i - 1 Then 'enable these line to skip singles
ReDim Preserve ArrRowNumbers(j + 1)
ArrRowNumbers(j) = k + FR - 1
ArrRowNumbers(j + 1) = i - 1 + FR - 1
j = j + 2
'End If 'enable these line to skip singles
Loop While i < LR

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

For i = 1 To j - 1 Step 2
HL = IIf(HL = 35, 36, 35)
Range(Cells(ArrRowNumbers(i), col), Cells(ArrRowNumbers(i + 1), col)).Interior.ColorIndex = HL
Next i

With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With

End Sub

03-17-2011, 02:24 PM
Conditional formatting using a Helper column