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
|