Magical, Norman. Thanks !
Runs great.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Norman Jones" wrote in message
...
Hi Max,

Try:

'================
Public Sub DeleteFlag()
Dim rng As range
Dim rCell As range
Dim delRng As range
Dim WB As Workbook
Dim SH As Worksheet
Dim CalcMode As Long
Dim ViewMode As Long
Const Flag As String = "Max" '<<===== CHANGE

Set WB = ActiveWorkbook '<<===== CHANGE
Set SH = WB.Sheets("Sheet1") '<<===== CHANGE

Set rng = Intersect(SH.UsedRange, SH.Columns("K:K"))

On Error GoTo XIT

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveWindow
ViewMode = .View
.View = xlNormalView
End With

SH.DisplayPageBreaks = False


For Each rCell In rng.Cells
With rCell
If InStr(1, .Value, Flag, vbTextCompare) Then
If delRng Is Nothing Then
Set delRng = .resize(9)
Else
Set delRng = Union(.resize(9), delRng)
End If
End If
End With
Next rCell

If Not delRng Is Nothing Then
delRng.EntireRow.Delete
Else
'nothing found, do nothing
End If

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

ActiveWindow.View = ViewMode

End Sub
'<<================


---
Regards,
Norman