Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
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
Posted to microsoft.public.excel.misc
|
|||
|
|||
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
Posted to microsoft.public.excel.misc
|
|||
|
|||
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
Posted to microsoft.public.excel.misc
|
|||
|
|||
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
Posted to microsoft.public.excel.misc
|
|||
|
|||
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
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Loop gone crazy | Excel Discussion (Misc queries) | |||
Do Loop | Excel Discussion (Misc queries) | |||
Help with Do...Loop | Excel Discussion (Misc queries) | |||
hysteresis loop | Charts and Charting in Excel | |||
loop trough e-mail address list to send task lists with outlook | Excel Discussion (Misc queries) |