Try

Kris

```
Sub kTest()
Dim i As Long, a(), Addr As String, n As Long, k, r As Range
Set r = Intersect(ActiveSheet.UsedRange, Columns(2))
k = r
For i = UBound(k, 1) To 1 Step -1
If InStr(1, k(i, 1), "-") Then
Addr = Addr & "," & "A" & i & ":A" & i + 4
If Len(Addr) > 240 Then
n = n + 1
ReDim Preserve a(1 To n)
a(n) = Mid$(Addr, 2)
Addr = vbNullString
End If
End If
Next
If Len(Addr) > 1 Then
n = n + 1
ReDim Preserve a(1 To n)
a(n) = Mid$(Addr, 2)
Addr = vbNullString
End If
If n Then
Application.ScreenUpdating = False
With r
For i = 1 To n
.Range(CStr(a(i))).EntireRow.Delete
Next
End With
End If
Application.ScreenUpdating = True
End Sub
```