Loop through worksheet & delete rows between two values

Dave_O

New Member
Joined
Dec 3, 2019
Messages
5
Office Version
  1. 2016
Platform
  1. Windows
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
ABC
11
2Computer Panels<KEEP ROW>
3R&S<delete Row>
4Contains Data<delete Row>
5Contains Data<delete Row>
6Contains Data<delete Row>
7R&S<KEEP ROW>
8
9
10
112
12Computer Panels<KEEP ROW>
13R&S<delete Row>
14Contains Data<delete Row>
15R&S<KEEP ROW>
16
17
18
193
20Computer Panels<KEEP ROW>
21R&S<delete Row>
22Contains Data<delete Row>
23Contains Data<delete Row>
24Contains Data<delete Row>
25Contains Data<delete Row>
26Contains Data<delete Row>
27Contains Data<delete Row>
28Contains Data<delete Row>
29R&S<KEEP ROW>
Import



VBA Code:
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
 

Attachments

  • Data.png
    Data.png
    15 KB · Views: 1

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,475
Office Version
  1. 365
Platform
  1. Windows
If your sample data is representative then this may work for you? Test with a copy of your data.

VBA Code:
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
 
Solution

Dave_O

New Member
Joined
Dec 3, 2019
Messages
5
Office Version
  1. 2016
Platform
  1. Windows
This new code works.
Thank you Peter for the quick response.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,475
Office Version
  1. 365
Platform
  1. Windows
You're welcome. Thanks for the follow-up. :)
 

Watch MrExcel Video

Forum statistics

Threads
1,129,450
Messages
5,636,337
Members
416,914
Latest member
DWC199

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top