Code needs modifiying to help when deleting rows

John T

Board Regular
Joined
Nov 28, 2013
Messages
145
Office Version
  1. 365
Platform
  1. Windows
Hi, I currently have the below code that deletes rows between row 220 - 40 if the data in column A for that row is blank.
Would it be possible to then rather than delete all rows, leave 10 blank rows after the last row in column A with data.
for example if row 40 were my only row then the 10 rows after that would be inserted.

The other option is to start at A1000 x1up and ofset it by -3 then insert 10 rows but i don't know which is the easiest way to go or how to add that to my existing code.

Thanks

Excel Formula:
Sub Del()

For r = 220 To 40 Step -1
Set Rng = Range("A" & r & ":i" & r)
If WorksheetFunction.CountA(Rng) = 0 Then
Rng.Resize(, 11).Delete Shift:=xlUp
End If
Next r

End Sub
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Hi John T. Maybe something like this...
Code:
Private Sub Test()
Dim Cnt As Integer
For Cnt = 40 To 220
If Sheets("Sheet1").Range("A" & Cnt) = vbNullString Then
Sheets("Sheet1").Range("A" & Cnt & ":A" & (Cnt + 10)).EntireRow.Insert
Cnt = Cnt + 10
End If
Next Cnt
End Sub
HTH. Dave
 
Upvote 0
Hi, Thanks for your reply.
Your code didn't work for me.
It added 100's of rows and only on certain columns.
Also the spredsheet name changes daily to be the date so i can't name it in the code as it constatly changes.
 
Upvote 0
Can you show a before and after example of your data (real or fictitious), prior to your second requirement of adding the 10 rows...
 
Upvote 0
Hi,

After running the code in my original post it looks like this.
I'd like 10 blank rows inserted after the last row with an invoice, before the word Receipts in column A.
In this instance 10 rows after row 72. but that row would be different each day.
As seen in the second image.
Thanks



1658246617683.png




1658246843588.png
 
Upvote 0
I don't know if you have data to the right of column J, if not, then perhaps something like this would work for you and be a drop quicker..

Please test on a back-up copy of your data

VBA Code:
Sub Del()

    Dim rng As Range
    Dim r As Long, lRow As Long
    
    Set rng = Range("A40:J220")
    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    lRow = Range("J40").End(xlDown).Row + 1
    Range("J" & lRow & ":J" & lRow + 10).EntireRow.Insert

End Sub
 
Upvote 0
Thanks for your suggestion but that deleted all of the rows between A40:J220 regardless if there was data in there.
It left me on row 40 when i had data up to row 80.
It didn't insert the extra rows either.
 
Upvote 0
That did not happen with my test sheet. Can you post an example of your sheet before any code is ran...

Do you get the same result with this change...

VBA Code:
Sub Del()

    Dim rng As Range
    Dim lRow As Long
    
    Set rng = Range("A40:A220")
    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    lRow = Range("J40").End(xlDown).Row + 1
    Range("J" & lRow & ":J" & lRow + 10).EntireRow.Insert

End Sub
 
Last edited:
Upvote 0
This is what it looks like after running the code now.


1658262321621.png
 
Upvote 0
And now...

VBA Code:
Sub Del()

    Dim rng As Range
    Dim lRow As Long
    
    Set rng = Range("A40:A220")
    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    lRow = Range("J40").End(xlDown).Row
    Range("J" & lRow & ":J" & lRow + 10).EntireRow.Insert

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,207
Members
448,554
Latest member
Gleisner2

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
Back
Top