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

[Blaise]

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.

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

 

[MickG]

Try this:-

[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]

Hi there. Try this:

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]

Try this:-

[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.

 

[MickG]

You're welcome