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

Hey John,

Thanks a lot for your valuable help nd time.There was some tipo with my code
.. Its working fine now.
Have a Great Day.


"john" wrote:

not sure what you are doing as this line €œlr = .Cells(.Rows.Count,
"Q").End(xlUp).Row€�
finds the last used cell from bottom of worksheet up so should not be
affected if some cells are blank between Q1 & last row.

I tested data as described & code worked its way to last populated cell in Q.

as an alternative try changing this line:

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

to this


For Each Cell In .UsedRange

(do not omit the period €œ.€� (full stop) in front of UsedRange)

& see if that helps.

Also, Mike has kindly responded along similar lines, take note of his
suggestions.

--
jb


"SR" wrote:

Hi John,

If I am using last used cell loop is closing at "Q2" as "Q3" is blank. But I
have data in Q4 and the loop needs to be run in Q4 also..

can we make all the blank cell in column Q to some other value before the
loop starts and make it blank again once the loop finish running?

"john" wrote:

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