Hi Graham

Try this

Set RngA = Range("H13", Range("H65536").End(xlUp))

Regards,

Per

On 24 Mar., 13:31, Graham wrote:
I modified a procedure which Phillip was kind enough to send me a short
time ago. It does what it should but I have one problem which I cannot
seem to get round. In column 8 the first 12 cells will always be blank,
* *I cannot put anything in them in this situation so need to work round
it. Basically it means the procedure doesn't need to start until it
reaches row 13. I have tried putting in If statements like "if not
isempty" to jump the procedure forward but cannot get it to work. If I
put values in the cells, as long as there are not more than 6 of the
same it works but I don't have the luxury of being able to put values in
these in this circumstance. I would be grateful for any guidance.

Kind Regards
Graham
Turriff
Scotland

Sub gmhtrial()
* * *Dim Rng As Range
* * *Dim rngA As Range
* * *Dim TotA As Double
* * *Dim TotB As Double
* * *Dim cl As Range
* * *Dim NextRow As Integer
* * *Dim ValueTomatch As String

* * *Set Rng = ActiveSheet.UsedRange
* * * Set rngA = Rng.Columns(8)
* * *Rng.Interior.ColorIndex = xlNone
* * *NextRow = 1
On Error Resume Next
* * *For Each cl In rngA.Cells
* * If NextRow = cl.Row Then
* * ValueTomatch = cl.Text
* *TotA = cl.Offset(0, 1).Value
* *Select Case WorksheetFunction.CountIf(rngA, ValueTomatch)
* *Case 1
* *NextRow = cl.Row + 1
* TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value
* If Round(TotA, 2) < Round(TotB, 2) Then
* Rng.Rows(cl.Row).Interior.ColorIndex = 6
* End If
* Case 2
* NextRow = cl.Row + 2
* TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value
* TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value
* If Round(TotA, 2) < Round(TotB, 2) Then
* Rng.Rows(cl.Row & ":" & (cl.Row + 1)).Interior.ColorIndex = 6
* End If
* Case 3
* NextRow = cl.Row + 3
* TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value
* TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value
* TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value
* If Round(TotA, 2) < Round(TotB, 2) Then
* Rng.Rows(cl.Row & ":" & cl.Row + 2).Interior.ColorIndex = 6
* End If
* Case 4
* NextRow = cl.Row + 4
* TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value
* TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value
* TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value
* TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value
* If Round(TotA, 2) < Round(TotB, 2) Then
* Rng.Rows(cl.Row & ":" & cl.Row + 3).Interior.ColorIndex = 6
* End If
* Case 5
* NextRow = cl.Row + 5
* TotB = cl.Offset(0, 7).Value + cl.Offset(0, 9).Value
* TotB = TotB + cl.Offset(1, 7).Value + cl.Offset(1, 9).Value
* TotB = TotB + cl.Offset(2, 7).Value + cl.Offset(2, 9).Value
* TotB = TotB + cl.Offset(3, 7).Value + cl.Offset(3, 9).Value
* TotB = TotB + cl.Offset(4, 7).Value + cl.Offset(4, 9).Value
If Round(TotA, 2) < Round(TotB, 2) Then
Rng.Rows(cl.Row & ":" & cl.Row + 4).Interior.ColorIndex = 6
* End If

* End Select
* End If
* Next
End Sub