Hi guys,

I want to delete groups of 9 continuous rows from where a flag: "X" is found
in col K. Eg: if K10 contains: "X", delete entire rows 10-18, and if K100
contains: "X", delete entire rows 100-108, and so on. Thanks.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---

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



"Max" wrote in message
...
Hi guys,

I want to delete groups of 9 continuous rows from where a flag: "X" is
found
in col K. Eg: if K10 contains: "X", delete entire rows 10-18, and if K100
contains: "X", delete entire rows 100-108, and so on. Thanks.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---

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

Hi Max,

"She Wore a Yellow Ribbon" is on TV now, but I managed to get
this put together...
If it doesn't work blame it on John Wayne.<g
Regards,
Jim Cone
San Francisco, USA
'-------------------------
Sub GetThemXRows()
Dim rngStart As Excel.Range
Dim lngRow As Long
Set rngStart = _
Application.Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("K")).Cells
For lngRow = rngStart.Rows.Count To 1 Step -1
If rngStart(lngRow).Value = "X" Then
rngStart(lngRow).Resize(9, 1).EntireRow.Delete
End If
Next ' lngRow
Set rngStart = Nothing
End Sub
'------------------------------


"Max" wrote in message...
Hi guys,

I want to delete groups of 9 continuous rows from where a flag: "X" is found
in col K. Eg: if K10 contains: "X", delete entire rows 10-18, and if K100
contains: "X", delete entire rows 100-108, and so on. Thanks.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---

Jim, thanks for the artillery. I'm pretty sure it's not because of John
Wayne, but I could not get the cannons to fire, despite several tries. My
attempts fizzled out dismally (nothing happened on the sheet). What can I do
to feel the power ?
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Jim Cone" wrote in message
...
Hi Max,

"She Wore a Yellow Ribbon" is on TV now, but I managed to get
this put together...
If it doesn't work blame it on John Wayne.<g
Regards,
Jim Cone
San Francisco, USA
'-------------------------
Sub GetThemXRows()
Dim rngStart As Excel.Range
Dim lngRow As Long
Set rngStart = _
Application.Intersect(ActiveSheet.UsedRange,
ActiveSheet.Columns("K")).Cells
For lngRow = rngStart.Rows.Count To 1 Step -1
If rngStart(lngRow).Value = "X" Then
rngStart(lngRow).Resize(9, 1).EntireRow.Delete
End If
Next ' lngRow
Set rngStart = Nothing
End Sub
'------------------------------

Max,
Well is was probably Joanne Dru's fault then. <g
Norman's approach using Instr is probably what's needed.
My code only works if "X" is the only thing in the cell.
Regards,
Jim Cone
http://www.realezsites.com/bus/primitivesoftware


"Max" wrote in message...
Hi guys,
I want to delete groups of 9 continuous rows from where a flag: "X" is found
in col K. Eg: if K10 contains: "X", delete entire rows 10-18, and if K100
contains: "X", delete entire rows 100-108, and so on. Thanks.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---

Jim, thanks for explaining the subtleties. It was the "case" of the letter
(the flag in col K). My keyboard (or my fingers, rather) weren't working
too well. When I tried it again with a true-blue upper case: "X" in col K,
your sub ran superb and beautiful, just like Joanne Dru in the movie <g.
Thanks!
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Jim Cone" wrote in message
...
Max,
Well is was probably Joanne Dru's fault then. <g
Norman's approach using Instr is probably what's needed.
My code only works if "X" is the only thing in the cell.
Regards,
Jim Cone
http://www.realezsites.com/bus/primitivesoftware


"Max" wrote in message...
Hi guys,
I want to delete groups of 9 continuous rows from where a flag: "X" is
found
in col K. Eg: if K10 contains: "X", delete entire rows 10-18, and if K100
contains: "X", delete entire rows 100-108, and so on. Thanks.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---