Delete rows if cell is blank plus delete the next 6 rows as well

Blaise

New Member
Joined
Sep 25, 2011
Messages
14
Hello,

I need to convert invoices including a tons of items to Excel.
When I copy the text and paste it into Excel there are several rows which are the footer. These are always the same 6 rows with a blank row in front of them.
When I have 20 pages it's quite timeconsuming to delete these groups one by one.

That would be great if I could do this by pressing a button.

I've found this code but this only deletes the rows where the cell in column A is blank.

Code:
Private Sub CommandButton1_Click()


    On Error Resume Next
        Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete


End Sub

Could you pls help me with a code that deletes the next 6 rows as well?

Thank you for you help in advance,
Balazs
 
Last edited:

Some videos you may like

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG26Mar45
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range, Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Columns("A").SpecialCells(xlCellTypeBlanks).Areas
    [COLOR="Navy"]If[/COLOR] Rng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] Rng = Dn.Resize(6) Else [COLOR="Navy"]Set[/COLOR] Rng = Union(Rng, Dn.Resize(6))
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]If[/COLOR] Not Rng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] Rng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

jmacleary

Well-known Member
Joined
Oct 5, 2015
Messages
1,023
Office Version
  1. 365
  2. 2007
Platform
  1. Windows
Hi there. Try this:

Code:
Sub deleter()
Dim blankrow As Range
Dim firstrow As Long
Dim lastrow As Long
For Each blankrow In Columns("A").SpecialCells(xlCellTypeBlanks)
    firstrow = blankrow.Row
    lastrow = firstrow + 6
    Rows(firstrow & ":" & lastrow).EntireRow.Delete

Next blankrow

End Sub
 

Blaise

New Member
Joined
Sep 25, 2011
Messages
14
Try this:-
Code:
[COLOR=Navy]Sub[/COLOR] MG26Mar45
[COLOR=Navy]Dim[/COLOR] Dn [COLOR=Navy]As[/COLOR] Range, Rng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]On[/COLOR] [COLOR=Navy]Error[/COLOR] [COLOR=Navy]Resume[/COLOR] [COLOR=Navy]Next[/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Columns("A").SpecialCells(xlCellTypeBlanks).Areas
    [COLOR=Navy]If[/COLOR] Rng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] Rng = Dn.Resize(6) Else [COLOR=Navy]Set[/COLOR] Rng = Union(Rng, Dn.Resize(6))
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]If[/COLOR] Not Rng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] Rng.EntireRow.Delete
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick

Thank you Mick for your quick help, this works perfectly. Exactly what I need.
 

Watch MrExcel Video

Forum statistics

Threads
1,108,614
Messages
5,523,919
Members
409,542
Latest member
Shezz01

This Week's Hot Topics

Top