It worked ok in 2003.

Rather than scan whole Column which would probably take a very long time in
2007 - i would limit search upto last used cell.

See if adjusted code helps

Sub CheckRange()
Dim Cell As Range
Dim ws As Worksheet
Dim lr As Long

Set ws = ActiveSheet

With ws

lr = .Cells(.Rows.Count, "Q").End(xlUp).Row


For Each Cell In .Range("Q1:Q" & lr)

If Cell.Value = _
dte And Cell.Offset(0, -6).Value = "XXX" Then

x = x + 1

ElseIf Cell.Value = _
dte And Cell.Offset(0, -6).Value = "YYY" Then

y = y + 1

ElseIf Cell.Value = _
dte And Cell.Offset(0, -6).Value = "ZZZ" Then

z = z + 1

ElseIf Cell.Value = _
dte And Cell.Offset(0, -6).Value = "XYZ" Then

i = i + 1

End If


Next Cell

End With


End Sub



jb


"SR" wrote:

I have tried this alredy, but it was not working. After running this the
workbook is not responding and I have to close the file.
Any other suggestion?

"SR" wrote:

Hi,

I need a loop which will check the below conditions in all the cell (even if
the cells are blank") in column Q ("Q:Q")

If ActiveCell.Value = dte And ActiveCell.Offset(0, -6).Value = "XXX" Then
x = x + 1
ElseIf ActiveCell.Value = dte And ActiveCell.Offset(0,
-6).Value = "YYY" Then
y = y + 1
ElseIf ActiveCell.Value = dte And ActiveCell.Offset(0,
-6).Value = "ZZZ" Then
z = z + 1
ElseIf ActiveCell.Value = dte And ActiveCell.Offset(0,
-6).Value = "XYZ" Then
i = i + 1

else

ActiveCell.Offset(1, 0).Select

Thanks in advance.

SR