Insert blank row for each full row

[samohtwerdna]

Hello all!

I have another request for help.

Our accountant would like to insert a blank row in a spreadsheet for each row with data currently filled out. She want's the new row inserted under the row containing data.

Now I can write:

Range( _
"2:2,3:3,4:4,5:5,6:6,7:7,8:8,9:9,10:10,11:11,12:12,13:13,14:14,15:15,16:16,1 7:17,18:18").Select
Range("A18").Activate
Selection.Insert Shift:=xlDown
but that is ugly and not to mention tedious - so I need a For Each statement that will check to see if a row has data then

Range("x:x").Select
Selection.Insert Shift: = xlDown
where x = numer of the row with data on it...Should work,

Any suggestions?

[Bob Phillips]

For i = Cells(Rows.Count,"A").End(xlUp).Row To 1 STep -1
If Application.CountA(Rows(i)) > 0 Then
Rows(i+1).Insert
End If
Next i

[mdmackillop]

If column A does not contain data, the following may provide a solution



Sub Inserts()
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Application.CountA(Rows(i)) > 0 Then
If Application.WorksheetFunction.CountBlank(Rows(i)) <> 256 Then
Rows(i + 1).Insert
End If
End If
Next i
End Sub

[samohtwerdna]

Thanks for the help!!

I also wanted to set the Row height of the inserted Row to 50 pts. When I add RowHeight = 50 to the loop - for some reason only the first four Row's after my selected cell change...Why is that??

Any Idea's about how to insert the new Row at a new height??

Thanks again!

[austenr]

Sub Inserts()
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Application.CountA(Rows(i)) > 0 Then
If Application.WorksheetFunction.CountBlank(Rows(i)) <> 256 Then
Rows(i + 1).Insert
Selection.RowHeight = 50
End If
End If
Next i
End Sub

[samohtwerdna]

Not sure what I'm doing wrong but I am still getting some inserted at 50 pts but most inserted @ the standard 17.25 pts or whatever the standard is.

Anyway I am dimensioning i as a Long - is that the problem??

[austenr]

Sorry. This should work



Option Explicit
Sub Inserts()
Dim i As Long
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Application.CountA(Rows(i)) > 0 Then
ActiveSheet.UsedRange.Rows.RowHeight = 50
If Application.WorksheetFunction.CountBlank(Rows(i)) <> 256 Then
Rows(i + 1).Insert
End If
End If
Next i
End Sub

[samohtwerdna]

Closer,

Now all the inserted Row's come in @ 50 pts - but so do the existing rows with data on them?

I only want to make the inserted Row's @ the new height

Thanks for the help!

[Norie]

This seems to work for me.


Sub Inserts()
Dim i As Long
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Application.CountA(Rows(i)) > 0 Then
If Application.WorksheetFunction.CountBlank(Rows(i)) <> 256 Then
Rows(i + 1).Insert
Rows(i + 1).RowHeight = 50
End If
End If
Next i
End Sub

[samohtwerdna]

Thanks Norie,

I guess I should have tried to be more specific about which row I wanted to to manipulate - Rows(i +1).RowHeight = 50 works great for me as well. I'm still not sure what excel was doing when I just had RowHieght = 50 - but I'm glad you solved my problem,

Andy

[samohtwerdna]

I know I marked this as solved, but I have a quick question:

I want to reverse the process - Find all the newly inserted rows and delete them. Or maybe eaiser and more functional - find all empty Rows in a selection and delete those.

Any thoughts?

[mdmackillop]

Hi Sam,
Try


Sub Deletes()
Dim Cel As Range
For Each Cel In Selection
If Application.WorksheetFunction.CountBlank(Cel.EntireRow) = 256 Then
Cel.EntireRow.Delete
End If
Next
End Sub

[Zack Barresse]

Malcolm, that will skip cells. It's best to iterate backwards when inserting/deleting...


Sub Deletes()
Dim i As Long, Rng As Range
Set Rng = Selection
For i = Rng.Cells.Count To 1 Step -1
If Application.WorksheetFunction.CountBlank(Rng(i).EntireRow) = 256 Then
Rng(i).EntireRow.Delete
End If
Next
End Sub

[mdmackillop]

Correct!:blush footinmout

[samohtwerdna]

Thanks Guy's!!
:thumb

[Zack Barresse]

Btw, I should have used a CountA instead of a CountBlank, especially in lieu of the next Office installment, will have more than 256 columns. :o:

[mdmackillop]

Hi Zack,
Will the problem with the new version will be the 256, not the CountBlanks? Columns.Count instead of 256 would solve that.
Regards
Malcolm

[samohtwerdna]

Thanks a lot for the help and the info!

Everything works great - I just have a curious question to add:

Is there a faster way to accomplish the same result?

I ask because the spreadsheets our accountant will be appling this to are around 3,000 rows large. When I tested the code on a test sheet with only about 60 rows the code executed almost instantly - but when I used it on the real macoy it took 9-10 min. :bug:

I have a simalar problem with a price find code that I wrote awhile back, once a sheet passes the 1,000 row mark - it seems to take an extra long time :think:

[Norie]

Things might run quicker if you turn off screen updating.


Sub Inserts()
Dim i As Long
Application.ScreenUpdating = False
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Application.CountA(Rows(i)) > 0 Then
If Application.WorksheetFunction.CountBlank(Rows(i)) <> 256 Then
Rows(i + 1).Insert
Rows(i + 1).RowHeight = 50
End If
End If
Next i
Application.ScreenUpdating = True
End Sub

[samohtwerdna]

Thanks Nori!

The offscreen updating is a bit faster - but I was wondering if I could aproach it like I would for setting the row height for the entire street. No matter how many Rows a sheet has it updates almost instantly... so could I select the content my self and just write an insert code for every other row?

Would that be faster??

[austenr]

If I understand your question, The screen updating feature works no matter how many rows you have or what you select. It is independent of any code.

[samohtwerdna]

YEAH I think?

You know when you select the entire sheet by clicking on the top left hand corner of the sheet and then say format the row height - the change is very, very fast - no matter how large the sheet, that's what I am talking about.

is there a way to format every other row just as fast?

I am sure I have to use VBA - but perhaps I dont have to loop through each row?

[austenr]

There are several ways to do just about everything, but in this case Norie's solution is the best and fastest way to go, IMHO. However, others may have something else to say.

[Zack Barresse]

Try using SpecialCells, xlCellTypeBlanks possibly. Maybe something like this ...

Option Explicit

Sub DeleteBlankRowsPlz()
Dim Rng As Range
Set Rng = Selection 'set as desired
On Error Resume Next
Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub