ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   Macro looping endlessly (https://www.excelbanter.com/excel-worksheet-functions/142292-macro-looping-endlessly.html)

Sandy
Macro looping endlessly
 
Hi

The following resets the cell interior to Dark Blue - which is fine

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
With .Validation
.Delete
End With
End With
End If

However I need to clear the contents of the cells too - if I do this

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
.ClearContents
With .Validation
.Delete
End With
End With
End If

it goes into an endless loop. Any suggestions

Sandy



JE McGimpsey
Macro looping endlessly
 
As listed, your code won't go into an endless loop, so there must be
something else going on.

Is your code within a Worksheet_Change() event macro? If so, clearing
the contents fires the Worksheet_Change() event (though the loop
shouldn't be endless - you'll eventually run out of stack space)

How is myCell determined? Do you have code that checks whether myCell is
empty?

BTW- Since you only use the .Delete method with the .Validation object,
you can replace your With .Validation...End With structure with

.Validation.Delete



In article ,
"Sandy" wrote:

Hi

The following resets the cell interior to Dark Blue - which is fine

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
With .Validation
.Delete
End With
End With
End If

However I need to clear the contents of the cells too - if I do this

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
.ClearContents
With .Validation
.Delete
End With
End With
End If

it goes into an endless loop. Any suggestions

Sandy

Toppers
Macro looping endlessly
 
Sandy,
You need the Application.EnableEvents logic to stop the looping:
your clearing the cells invokes the macro again (and again ...!). Not sure
where you want your new code.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

On Error GoTo ws_exit '<===
Application.EnableEvents = False '<===
For Each myCell In Range("C13:G13,M13:Q13")
If myCell.Value = "Miss" Then

With myCell.Offset(1)
.Interior.ColorIndex = 36 'Light Yellow
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList,
Formula1:="Left,Right,Short,Long"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(2)
.Interior.ColorIndex = 36 'Light Yellow
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="Yes,No"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(3)
.Interior.ColorIndex = 36 'Light Yellow
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="Yes,No"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(1).Resize(3, 1)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue,
Operator:=xlGreater, _
Formula1:="0"
.FormatConditions(1).Font.ColorIndex = 2
.FormatConditions(1).Interior.ColorIndex = 5
End With
End If
Next
ws_exit: '<===
Application.EnableEvents = True '<====
End Sub

"Sandy" wrote:

Hi

The following resets the cell interior to Dark Blue - which is fine

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
With .Validation
.Delete
End With
End With
End If

However I need to clear the contents of the cells too - if I do this

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
.ClearContents
With .Validation
.Delete
End With
End With
End If

it goes into an endless loop. Any suggestions

Sandy




Sandy
Macro looping endlessly
 
Full code added below

"Sandy" wrote in message
...
Hi

The following resets the cell interior to Dark Blue - which is fine

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
With .Validation
.Delete
End With
End With
End If

However I need to clear the contents of the cells too - if I do this

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
.ClearContents
With .Validation
.Delete
End With
End With
End If

it goes into an endless loop. Any suggestions

Sandy
Here is the full macro if it helps

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

For Each myCell In Range("C13:F13,M13:P13")
If myCell.Value = "Miss" Then
With myCell.Offset(1)
.Interior.ColorIndex = 36
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11

With .Validation
.Delete
.Add Type:=xlValidateList,
Formula1:="Left,Right,Short,Long"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(2)
.Interior.ColorIndex = 36
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="Yes,No"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(3)
.Interior.ColorIndex = 36
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="Yes,No"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(1).Resize(3, 1)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue,
Operator:=xlGreater, Formula1:="0"
.FormatConditions(1).Font.ColorIndex = 2
.FormatConditions(1).Interior.ColorIndex = 11
End With
End If

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
With .Validation
.Delete
End With
End With
End If
Next
End Sub

I need to clear the contents in the 3 cells below each myCell containing
"Hit"



Toppers
Macro looping endlessly
 
try:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

On Error GoTo ws_exit
Application.EnableEvents = False
For Each myCell In Range("C13:G13,M13:Q13")

If myCell.Value = "Miss" Then
With myCell.Offset(1)
.Interior.ColorIndex = 36 'Light Yellow
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList,
Formula1:="Left,Right,Short,Long"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(2)
.Interior.ColorIndex = 36 'Light Yellow
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="Yes,No"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(3)
.Interior.ColorIndex = 36 'Light Yellow
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="Yes,No"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(1).Resize(3, 1)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue,
Operator:=xlGreater, _
Formula1:="0"
.FormatConditions(1).Font.ColorIndex = 2
.FormatConditions(1).Interior.ColorIndex = 11
End With
End If
If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
.ClearContents
With .Validation
.Delete
End With
End With
End If
Next
ws_exit:
Application.EnableEvents = True
End Sub

"Sandy" wrote:

Full code added below

"Sandy" wrote in message
...
Hi

The following resets the cell interior to Dark Blue - which is fine

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
With .Validation
.Delete
End With
End With
End If

However I need to clear the contents of the cells too - if I do this

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
.ClearContents
With .Validation
.Delete
End With
End With
End If

it goes into an endless loop. Any suggestions

Sandy
Here is the full macro if it helps

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

For Each myCell In Range("C13:F13,M13:P13")
If myCell.Value = "Miss" Then
With myCell.Offset(1)
.Interior.ColorIndex = 36
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11

With .Validation
.Delete
.Add Type:=xlValidateList,
Formula1:="Left,Right,Short,Long"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(2)
.Interior.ColorIndex = 36
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="Yes,No"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(3)
.Interior.ColorIndex = 36
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="Yes,No"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(1).Resize(3, 1)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue,
Operator:=xlGreater, Formula1:="0"
.FormatConditions(1).Font.ColorIndex = 2
.FormatConditions(1).Interior.ColorIndex = 11
End With
End If

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
With .Validation
.Delete
End With
End With
End If
Next
End Sub

I need to clear the contents in the 3 cells below each myCell containing
"Hit"




Sandy
Macro looping endlessly
 
Once again thank you Toppers - the added code top and bottom did the trick

And John thank you - I have abbreviated the lines you mentioned

Sandy

"Toppers" wrote in message
...
Sandy,
You need the Application.EnableEvents logic to stop the
looping:
your clearing the cells invokes the macro again (and again ...!). Not sure
where you want your new code.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

On Error GoTo ws_exit '<===
Application.EnableEvents = False '<===
For Each myCell In Range("C13:G13,M13:Q13")
If myCell.Value = "Miss" Then

With myCell.Offset(1)
.Interior.ColorIndex = 36 'Light Yellow
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList,
Formula1:="Left,Right,Short,Long"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(2)
.Interior.ColorIndex = 36 'Light Yellow
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="Yes,No"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(3)
.Interior.ColorIndex = 36 'Light Yellow
.BorderAround LineStyle:=xlContinuous,
Weight:=xlThin, _
ColorIndex:=11
With .Validation
.Delete
.Add Type:=xlValidateList, Formula1:="Yes,No"
.IgnoreBlank = True
.InCellDropdown = True
End With
End With

With myCell.Offset(1).Resize(3, 1)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue,
Operator:=xlGreater, _
Formula1:="0"
.FormatConditions(1).Font.ColorIndex = 2
.FormatConditions(1).Interior.ColorIndex = 5
End With
End If
Next
ws_exit: '<===
Application.EnableEvents = True '<====
End Sub

"Sandy" wrote:

Hi

The following resets the cell interior to Dark Blue - which is fine

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
With .Validation
.Delete
End With
End With
End If

However I need to clear the contents of the cells too - if I do this

If myCell.Value = "Hit" Then
With myCell.Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
.ClearContents
With .Validation
.Delete
End With
End With
End If

it goes into an endless loop. Any suggestions

Sandy

JE McGimpsey
Macro looping endlessly
 
One way:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim myCell As Range
For Each myCell In Range("C13:F13,M13:P13")
With myCell
If .Value = "Miss" Then
With .Offset(1, 0).Resize(3, 1)
.Interior.ColorIndex = 36
.BorderAround _
LineStyle:=xlContinuous, _
Weight:=xlThin, _
ColorIndex:=11
.Validation.Delete
With .Cells(1).Validation
.Add _
Type:=xlValidateList, _
Formula1:="Left,Right,Short,Long"
.IgnoreBlank = True
.InCellDropdown = True
End With
With .Cells(2).Validation
.Add _
Type:=xlValidateList, _
Formula1:="Yes,No"
.IgnoreBlank = True
.InCellDropdown = True
End With
With .Cells(3).Validation
.Add _
Type:=xlValidateList, _
Formula1:="Yes,No"
.IgnoreBlank = True
.InCellDropdown = True
End With
With .FormatConditions
.Delete
.Add _
Type:=xlCellValue, _
Operator:=xlGreater, _
Formula1:="0"
.Item(1).Font.ColorIndex = 2
.Item(1).Interior.ColorIndex = 11
End With
End With
ElseIf .Value = "Hit" Then
With .Offset(1).Resize(3, 1)
.Interior.ColorIndex = 11
.Validation.Delete
Application.EnableEvents = False
.ClearContents
Application.EnableEvents = True
End With
End If
End With
Next myCell
End Sub


In article ,
"Sandy" wrote:

Full code added below


All times are GMT +1. The time now is 08:47 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com