Delete Selected Rows

K

Ken

We have a workbook with data like the following (lower
case letters are just fillers):
A B
1 rrr
2 eee
3 SUMMARY
4 lll
5 ppp
6 STATION XYZ
7 kkk
8 SUMMARY
9 mmm
10 STATION AAA

The word "STATION" will have varying text after it in the
cell. The total number of rows will vary. The number of
rows between the words "SUMMARY" and "STATION" will vary.

We want our macro to delete the rows between the
words "SUMMARY" and "STATION" (inclusive) each time they
are found.

In the above example rows 8-10 and rows 3-6 would be
deleted.

We assume that we would start at the end and work up and
that we would be looking for "Left(A1,6) = "STATION"", but
can't figure out the code to make it happen.

TIA.
 
T

Tom Ogilvy

in B1 put in

=IF(AND(COUNTIF($A$1:A1,"Summary")<>COUNTIF($A$1:A1,"*Station*"),A1<>"summar
y"),"no match","match")

then drag fill down the column. Select A1 and do Data=>Filter=>Autofilter

select the dropdown in B1 and filter on "No Match"

Select all you data except the first row and do Edit=>Delete

turn off the autofilter (Data=>Filter=>Autofilter)

you can use a similar approach in a macro if you want.
 
S

Steve

The following macro will do what you want:

Sub Macro1()
'
'

' Get number of rows
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
rowsData = Selection.Rows.Count

Range("A1").Select
rowOffsetValue = 1

' Delete rows between and including SUMMARY and STATION

For I = 1 To rowsData

If Left(ActiveCell.Value, 7) = "SUMMARY" Or
rowOffsetValue = 0 Then
ActiveCell.EntireRow.Select
Selection.Delete Shift:=xlUp
rowOffsetValue = 0
End If

If Left(ActiveCell.Value, 7) = "STATION" Then
ActiveCell.EntireRow.Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(rowOffsetValue, 0).Select
rowOffsetValue = 1
GoTo continueChecking
End If

ActiveCell.Offset(rowOffsetValue, 0).Select

continueChecking:

Next I
'

Range("A1").Select

'
End Sub
 
Top