Sorry I am still being a pain, but it will run but not identify the
problem rows. I reference my original post which gave a bit more detail,
21st March, 20:06, "Check Totals in range". Note that this shows what I
am now referring to as column 8 in the first column and does not show
the blanks above it or the fact that the used range still starts at A1.
The used range still comes into it as per the formating of the offending
rows
Rng.Rows(cl.Row).Interior.ColorIndex = 6

Thanks for your continued help.

Graham

JLGWhiz wrote:
I think Mark and Per were on the right track. If both of these changes are
made it should start on row 13. See modified portion of code below. Also, I
could not see any reason to reference the UsedRange throughout the procedure,
but my old eyes are not what they used to be. I could be missing something
without actually running the code.

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
LstRow = Cells(Rows.Count, 8).End(xlUp).Row '<<<<<mod
Set Rng = ActiveSheet.UsedRange
Set rngA = Range("H13" & LstRow) '<<<<<mod
Rng.Interior.ColorIndex = xlNone
NextRow = 13 '<<<<<mod

"Graham" wrote:

Hi Mark,
Reply as to Per. Tried that as well but problem is with being
stuck with the used range including row 1.
Thanks for input.

Graham

Mark Ivey wrote:
Just taking a quick look at your code...

Try changing the following line of your code:

NextRow = 1

TO THIS...

NextRow = 13

This should start you at row 13.

Mark

"Graham" wrote in message
...
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