JimS
10-14-2009, 12:47 PM
In order to get the following code to run cleanly I must add “Application.EnableCancelKey = xlDisabled” before it.
Without the CancelKey Disabled it will randomly stop.
Any obvious errors?
Thanks...
JimS
Sub count()
Application.ScreenUpdating = False
lengthB = 0
lengthB = Worksheets("Sheet1").Cells(Rows.count, 2).End(xlUp).Row
minVal = Range("Low")
dropCounter = 0
cellCounter = 0
For i = 1 To (lengthB - 2)
tot1 = WorksheetFunction.Round(Sheets("Sheet1").Range("B" & i).Value, 5)
If tot1 < minVal Then
tot2 = WorksheetFunction.Round(Sheets("Sheet1").Range("B" & i + 1).Value, 5)
tot3 = WorksheetFunction.Round(Sheets("Sheet1").Range("B" & i + 2).Value, 5)
tot4 = WorksheetFunction.Round(Sheets("Sheet1").Range("B" & i + 3).Value, 5)
If tot1 >= tot2 And tot2 >= tot3 And tot3 >= tot4 Then
MsgBox i
dropCounter = dropCounter + 1
Do While minVal >= tot1
Sheets("Sheet1").Range("B" & i).Select
Selection.Delete Shift:=xlUp
lengthB = lengthB - 1
cellCounter = cellCounter + 1
If IsEmpty(Sheets("Sheet1").Range("B" & i).Value) Then
Exit For
Else
tot1 = WorksheetFunction.Round(Sheets("Sheet1").Range("B" & i).Value, 5)
End If
Loop
End If
End If
Next i
Sheets("# Removed").Range("K2").Value = dropCounter
Sheets("# Removed").Range("M2").Value = cellCounter
Application.ScreenUpdating = True
End Sub
Without the CancelKey Disabled it will randomly stop.
Any obvious errors?
Thanks...
JimS
Sub count()
Application.ScreenUpdating = False
lengthB = 0
lengthB = Worksheets("Sheet1").Cells(Rows.count, 2).End(xlUp).Row
minVal = Range("Low")
dropCounter = 0
cellCounter = 0
For i = 1 To (lengthB - 2)
tot1 = WorksheetFunction.Round(Sheets("Sheet1").Range("B" & i).Value, 5)
If tot1 < minVal Then
tot2 = WorksheetFunction.Round(Sheets("Sheet1").Range("B" & i + 1).Value, 5)
tot3 = WorksheetFunction.Round(Sheets("Sheet1").Range("B" & i + 2).Value, 5)
tot4 = WorksheetFunction.Round(Sheets("Sheet1").Range("B" & i + 3).Value, 5)
If tot1 >= tot2 And tot2 >= tot3 And tot3 >= tot4 Then
MsgBox i
dropCounter = dropCounter + 1
Do While minVal >= tot1
Sheets("Sheet1").Range("B" & i).Select
Selection.Delete Shift:=xlUp
lengthB = lengthB - 1
cellCounter = cellCounter + 1
If IsEmpty(Sheets("Sheet1").Range("B" & i).Value) Then
Exit For
Else
tot1 = WorksheetFunction.Round(Sheets("Sheet1").Range("B" & i).Value, 5)
End If
Loop
End If
End If
Next i
Sheets("# Removed").Range("K2").Value = dropCounter
Sheets("# Removed").Range("M2").Value = cellCounter
Application.ScreenUpdating = True
End Sub