Macro looping endlessly

S

Sandy

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
 
J

JE McGimpsey

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
 
T

Toppers

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
 
S

Sandy

Full code added below

Sandy said:
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
Click to expand...

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"
 
T

Toppers

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
 
S

Sandy

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
 
J

JE McGimpsey

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
 
Top