Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
Naji
 
Posts: n/a
Default 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

  #2   Report Post  
Posted to microsoft.public.excel.misc
JE McGimpsey
 
Posts: n/a
Default For Next Infinite Loop

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 . com,
"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

  #3   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson
 
Posts: n/a
Default For Next Infinite Loop

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
  #4   Report Post  
Posted to microsoft.public.excel.misc
TomHinkle
 
Posts: n/a
Default For Next Infinite Loop

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


  #5   Report Post  
Posted to microsoft.public.excel.misc
Naji
 
Posts: n/a
Default For Next Infinite Loop

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



  #6   Report Post  
Posted to microsoft.public.excel.misc
mikelee101
 
Posts: n/a
Default For Next Infinite Loop

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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Loop gone crazy Dave Peterson Excel Discussion (Misc queries) 4 December 16th 05 04:38 PM
Do Loop Noemi Excel Discussion (Misc queries) 0 December 8th 05 11:43 PM
Help with Do...Loop Noemi Excel Discussion (Misc queries) 1 December 7th 05 01:59 AM
hysteresis loop olivekim Charts and Charting in Excel 1 October 28th 05 04:22 AM
loop trough e-mail address list to send task lists with outlook Paul. Excel Discussion (Misc queries) 2 April 14th 05 11:48 AM


All times are GMT +1. The time now is 05:44 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"