For Next Infinite Loop

I am getting an infinite loop when I run this code and today's date
isn't found. I'd like it to do nothing if it's not found. How would I
do that ?

For Each rCell In Selection
If rCell.Value = Date Then Range(rCell.Address).Offset(1, 0).Activate




Next rCell

That code by itself won't produce an infinite loop - it will check each
cell in the Selection then stop.

Do you have event macros running?

In article <[email protected]>,
"Naji" <[email protected]> wrote:

> I am getting an infinite loop when I run this code and today's date
> isn't found. I'd like it to do nothing if it's not found. How would I
> do that ?
>
> For Each rCell In Selection
> If rCell.Value = Date Then Range(rCell.Address).Offset(1, 0).Activate
>
>
>
>
> Next rCell

Maybe...

For Each rCell In Selection
If rCell.Value = Date Then
rcell.Offset(1, 0).Activate
exit for
end if
Next rCell

Naji wrote:
>
> I am getting an infinite loop when I run this code and today's date
> isn't found. I'd like it to do nothing if it's not found. How would I
> do that ?
>
> For Each rCell In Selection
> If rCell.Value = Date Then Range(rCell.Address).Offset(1, 0).Activate
>
>
>
> Next rCell

--

Dave Peterson

done EVER use Selection as the range for a loop.
Selection is directly tied to the interface, and in fact when you say
..activate, you change the selection and the way the loop will work.

Better to specify which cells you want to cycle through..

Try
For each rCell in Range("A1:A200")



"Naji" wrote:

> I am getting an infinite loop when I run this code and today's date
> isn't found. I'd like it to do nothing if it's not found. How would I
> do that ?
>
> For Each rCell In Selection
> If rCell.Value = Date Then Range(rCell.Address).Offset(1, 0).Activate
>
>
>
>
> Next rCell
>
>

OK I am still getting an infinite loop. This is the code I have. What
it does is look for a date and then once the date is found, it shades
in the cells with different colors. This is a production forecast where
different colors indicate where the material is coming from.


Sub ColorHM()
Range("C4:BN6").Select
Application.CutCopyMode = False
Selection.Interior.ColorIndex = xlNone
Range("C10:BN12").Select
Range("BN10").Activate
Selection.Interior.ColorIndex = xlNone
Range("C16:BM18").Select
Selection.Interior.ColorIndex = xlNone
Range("C28:BM30").Select
Selection.Interior.ColorIndex = xlNone
Range("B34:BM36").Select
Selection.Interior.ColorIndex = xlNone
Range("C40:BN42").Select
Selection.Interior.ColorIndex = xlNone
Range("C46:BM48").Select
Selection.Interior.ColorIndex = xlNone

Dim theRow As Integer
Dim theCol As Integer
Dim NumX As Single
Dim Color1 As Integer
Dim Color2 As Integer
Dim Color3 As Integer
Dim Color4 As Integer
Dim Color6 As Integer
Dim ColorB As Integer
Dim Prod01 As Single
Dim Prod02 As Single
Dim Prod03 As Single
Dim Prod04 As Single
Dim Prod06 As Single
Dim ProdBal As Single
Dim Fcst01 As Single
Dim Fcst02 As Single
Dim Fcst03 As Single
Dim Fcst04 As Single
Dim Fcst06 As Single
Dim FcstBal As Single
Dim theCell

Color1 = Range(LegendLoc).Offset(0, 0).Interior.ColorIndex
Color2 = Range(LegendLoc).Offset(1, 0).Interior.ColorIndex
Color3 = Range(LegendLoc).Offset(2, 0).Interior.ColorIndex
Color4 = Range(LegendLoc).Offset(3, 0).Interior.ColorIndex
Color6 = Range(LegendLoc).Offset(4, 0).Interior.ColorIndex
ColorB = Range(LegendLoc).Offset(5, 0).Interior.ColorIndex

Prod01 = Sheets("HM Calcs").Range("B6").Value
Prod02 = Sheets("HM Calcs").Range("C6").Value
Prod03 = Sheets("HM Calcs").Range("D6").Value
Prod04 = Sheets("HM Calcs").Range("E6").Value
Prod06 = Sheets("HM Calcs").Range("F6").Value
ProdBal = Sheets("HM Calcs").Range("G6").Value
Fcst01 = Sheets("HM Calcs").Range("H6").Value
Fcst02 = Sheets("HM Calcs").Range("I6").Value
Fcst03 = Sheets("HM Calcs").Range("J6").Value
Fcst04 = Sheets("HM Calcs").Range("K6").Value
Fcst06 = Sheets("HM Calcs").Range("L6").Value
FcstBal = Sheets("HM Calcs").Range("M6").Value

NumX = 0#


Dim rCell


For Each rCell In Range("C3:BO3")


If rCell.Value = Date Then
rCell.Offset(1, 0).Activate
Exit For
End If
Next rCell


For Each rCell In Selection

For theCol = 0 To 50
For theRow = 0 To 2

If rCell.Offset(theRow, theCol).Value = "X" Or rCell.Offset(theRow,
theCol).Value = "1/2" Or rCell.Offset(theRow, theCol).Value = "Y" Then
If rCell.Offset(theRow, theCol).Value = "X" Then
NumX = NumX + 1
ElseIf rCell.Offset(theRow, theCol).Value = "1/2" Then
NumX = NumX + 0.5
ElseIf rCell.Offset(theRow, theCol).Value = "Y" Then
NumX = NumX + 0.9574
End If
With rCell.Offset(theRow, theCol).Interior
.Pattern = xlSolid
If NumX > FcstBal Then
.Pattern = xlAutomatic
.ColorIndex = None
ElseIf NumX > Fcst06 Then
.ColorIndex = ColorB
ElseIf NumX > Fcst04 Then
.ColorIndex = Color6
ElseIf NumX > Fcst03 Then
.ColorIndex = Color4
ElseIf NumX > Fcst02 Then
.ColorIndex = Color3
ElseIf NumX > Fcst01 Then
.ColorIndex = Color2
ElseIf NumX > ProdBal Then
.ColorIndex = Color1
ElseIf NumX > Prod06 Then
.ColorIndex = ColorB
ElseIf NumX > Prod04 Then
.ColorIndex = Color6
ElseIf NumX > Prod03 Then
.ColorIndex = Color4
ElseIf NumX > Prod02 Then
.ColorIndex = Color3
ElseIf NumX > Prod01 Then
.ColorIndex = Color2
Else
.ColorIndex = Color1
End If
End With
Else
With rCell.Offset(theRow, theCol).Interior
.Pattern = xlAutomatic
.ColorIndex = None
End With
End If

Next theRow
Next theCol

Next rCell
Range("A1").Select

End Sub

Naji,
What do you want the routine to do if it does NOT find today's date in the
range. After your first For each...Next loop, you then go to another set of
nested loops:

For Each rCell In Selection

For theCol = 0 To 50
For theRow = 0 To 2

Inside these loops you have somewhere around 50 lines of code to be
executed. Depending on what "selection" is when it reaches these loops (and
your processor speed), this could appear to be an infinite loop.

Without any comments in the code, it's a little tough to figure out what
it's trying to do, but it looks like you are looping through your range and
activating the cells with today's date in them. Then it appears you want to
loop through the activated cells (which would only be one if the date is
found?) and evaluate some data that is offset 0 to 2 rows and 0 to 50 columns
from the activated cell. If that's the case, you might be better off with
one loop that evaluates the offsets as soon as it finds the date, instead of
two loops. For instance:

For Each rCell In Range("C3:BO3")

If rCell.Value = Date Then Gosub Eval_Cell 'if it matches the date, go
through the loop below

Next rCell
Range("A1").Select
Exit Sub 'exit the routine when all cells in range c3:bo3 have been evaluated


Eval_Cell: 'beginning of the evaluation subroutine
For theCol = 0 To 50
For theRow = 0 To 2

<code between loop>

Next theRow
Next theCol

Return 'after evaluating the cell, return to check the date in the next rCell

End Sub


If I'm way off base on what you're shooting for, this probably doesn't help.
However, if I'm close, it might give you a starting point on another way to
attack it. You might also want to add a line similar to

Debug.Print rCell.address

to keep an eye on where it is in the loop to know if it's truly infinite or
stalled or if it's just taking a while to evaluate all the conditions.

Good Luck.

Mike Lee

"Naji" wrote:

> OK I am still getting an infinite loop. This is the code I have. What
> it does is look for a date and then once the date is found, it shades
> in the cells with different colors. This is a production forecast where
> different colors indicate where the material is coming from.
>
>
> Sub ColorHM()
> Range("C4:BN6").Select
> Application.CutCopyMode = False
> Selection.Interior.ColorIndex = xlNone
> Range("C10:BN12").Select
> Range("BN10").Activate
> Selection.Interior.ColorIndex = xlNone
> Range("C16:BM18").Select
> Selection.Interior.ColorIndex = xlNone
> Range("C28:BM30").Select
> Selection.Interior.ColorIndex = xlNone
> Range("B34:BM36").Select
> Selection.Interior.ColorIndex = xlNone
> Range("C40:BN42").Select
> Selection.Interior.ColorIndex = xlNone
> Range("C46:BM48").Select
> Selection.Interior.ColorIndex = xlNone
>
> Dim theRow As Integer
> Dim theCol As Integer
> Dim NumX As Single
> Dim Color1 As Integer
> Dim Color2 As Integer
> Dim Color3 As Integer
> Dim Color4 As Integer
> Dim Color6 As Integer
> Dim ColorB As Integer
> Dim Prod01 As Single
> Dim Prod02 As Single
> Dim Prod03 As Single
> Dim Prod04 As Single
> Dim Prod06 As Single
> Dim ProdBal As Single
> Dim Fcst01 As Single
> Dim Fcst02 As Single
> Dim Fcst03 As Single
> Dim Fcst04 As Single
> Dim Fcst06 As Single
> Dim FcstBal As Single
> Dim theCell
>
> Color1 = Range(LegendLoc).Offset(0, 0).Interior.ColorIndex
> Color2 = Range(LegendLoc).Offset(1, 0).Interior.ColorIndex
> Color3 = Range(LegendLoc).Offset(2, 0).Interior.ColorIndex
> Color4 = Range(LegendLoc).Offset(3, 0).Interior.ColorIndex
> Color6 = Range(LegendLoc).Offset(4, 0).Interior.ColorIndex
> ColorB = Range(LegendLoc).Offset(5, 0).Interior.ColorIndex
>
> Prod01 = Sheets("HM Calcs").Range("B6").Value
> Prod02 = Sheets("HM Calcs").Range("C6").Value
> Prod03 = Sheets("HM Calcs").Range("D6").Value
> Prod04 = Sheets("HM Calcs").Range("E6").Value
> Prod06 = Sheets("HM Calcs").Range("F6").Value
> ProdBal = Sheets("HM Calcs").Range("G6").Value
> Fcst01 = Sheets("HM Calcs").Range("H6").Value
> Fcst02 = Sheets("HM Calcs").Range("I6").Value
> Fcst03 = Sheets("HM Calcs").Range("J6").Value
> Fcst04 = Sheets("HM Calcs").Range("K6").Value
> Fcst06 = Sheets("HM Calcs").Range("L6").Value
> FcstBal = Sheets("HM Calcs").Range("M6").Value
>
> NumX = 0#
>
>
> Dim rCell
>
>
> For Each rCell In Range("C3:BO3")
>
>
> If rCell.Value = Date Then
> rCell.Offset(1, 0).Activate
> Exit For
> End If
> Next rCell
>
>
> For Each rCell In Selection
>
> For theCol = 0 To 50
> For theRow = 0 To 2
>
> If rCell.Offset(theRow, theCol).Value = "X" Or rCell.Offset(theRow,
> theCol).Value = "1/2" Or rCell.Offset(theRow, theCol).Value = "Y" Then
> If rCell.Offset(theRow, theCol).Value = "X" Then
> NumX = NumX + 1
> ElseIf rCell.Offset(theRow, theCol).Value = "1/2" Then
> NumX = NumX + 0.5
> ElseIf rCell.Offset(theRow, theCol).Value = "Y" Then
> NumX = NumX + 0.9574
> End If
> With rCell.Offset(theRow, theCol).Interior
> .Pattern = xlSolid
> If NumX > FcstBal Then
> .Pattern = xlAutomatic
> .ColorIndex = None
> ElseIf NumX > Fcst06 Then
> .ColorIndex = ColorB
> ElseIf NumX > Fcst04 Then
> .ColorIndex = Color6
> ElseIf NumX > Fcst03 Then
> .ColorIndex = Color4
> ElseIf NumX > Fcst02 Then
> .ColorIndex = Color3
> ElseIf NumX > Fcst01 Then
> .ColorIndex = Color2
> ElseIf NumX > ProdBal Then
> .ColorIndex = Color1
> ElseIf NumX > Prod06 Then
> .ColorIndex = ColorB
> ElseIf NumX > Prod04 Then
> .ColorIndex = Color6
> ElseIf NumX > Prod03 Then
> .ColorIndex = Color4
> ElseIf NumX > Prod02 Then
> .ColorIndex = Color3
> ElseIf NumX > Prod01 Then
> .ColorIndex = Color2
> Else
> .ColorIndex = Color1
> End If
> End With
> Else
> With rCell.Offset(theRow, theCol).Interior
> .Pattern = xlAutomatic
> .ColorIndex = None
> End With
> End If
>
> Next theRow
> Next theCol
>
> Next rCell
> Range("A1").Select
>
> End Sub
>
>