Loop through worksheet & delete rows between two values

[Dave_O]

Hello,
I have an "Import" worksheet where I loop thru the sheet to delete rows between two values in column A
The row count changes each time the data is imported (can be 4rows, 2rows, 23rows, etc)

1. Find "Control Panels" (Keep)
2. Find the Second occurrence of "R&S" (Keep)
3. Delete all rows in-between (there is data & blank cells mixed in these rows)

The problem is the loop deletes the second occurrence of "R&S" or not enough rows in-between.

Book1
	A	B	C
1	1
2	Computer Panels		<KEEP ROW>
3	R&S		<delete Row>
4	Contains Data		<delete Row>
5	Contains Data		<delete Row>
6	Contains Data		<delete Row>
7	R&S		<KEEP ROW>
8
9
10
11	2
12	Computer Panels		<KEEP ROW>
13	R&S		<delete Row>
14	Contains Data		<delete Row>
15	R&S		<KEEP ROW>
16
17
18
19	3
20	Computer Panels		<KEEP ROW>
21	R&S		<delete Row>
22	Contains Data		<delete Row>
23	Contains Data		<delete Row>
24	Contains Data		<delete Row>
25	Contains Data		<delete Row>
26	Contains Data		<delete Row>
27	Contains Data		<delete Row>
28	Contains Data		<delete Row>
29	R&S		<KEEP ROW>
Import

Sub Delete_Range

Dim lRow As Long, sRow As Long, tRow As Long, nRow As Long, CS As Long
    lRow = Cells(Rows.Count, 1).End(xlUp).Row ' Gets the last populated row in Col A
    For i = lRow To 1 Step -1
    CS = Cells(Rows.Count, "A").End(xlUp).Row
    sRow = Sheets("Import").Range("A:A").Find(what:="Computer Panels").Row
    tRow = Sheets("Import").Range("A:A").Find(what:="R&S").Row
    nRow = Sheets("Import").Range("A" & tRow + 1 & ":A" & lRow).Find(what:="R&S").Row
    Rowno = (nRow - sRow)

      If Left(Cells(i, "A").Text, 15) = "Computer Panels" Then Range(Cells(i + 1, 1), Cells(i + Rowno - 1, 1)).EntireRow.Delete
   Next i

End Sub

 

[Peter_SSs]

If your sample data is representative then this may work for you? Test with a copy of your data.

Sub DeleteSectios()
  Dim rA As Range
  
  For Each rA In Columns("A").SpecialCells(xlConstants).Areas
    rA.Offset(2).Resize(rA.Rows.Count - 3).EntireRow.Delete
  Next rA
End Sub

 

[Dave_O]

This new code works.
Thank you Peter for the quick response.

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.