Insert blank row for each full row

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:

Code:

---

    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,17: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

Code:

---

Range("x:x").Select
Selection.Insert Shift: = xlDown

---

where x = numer of the row with data on it...Should work,

Any suggestions?

Code:

---

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

---

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

Code:

---


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

---

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!

Code:

---

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

---

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??

Sorry. This should work

Code:

---

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

---

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!

This seems to work for me.

Code:

---

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

---

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

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?

Hi Sam,
Try

Code:

---


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

---

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

Code:

---

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

---

Correct!:blush footinmout

Thanks Guy's!!
:thumb

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:

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

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:

Things might run quicker if you turn off screen updating.

Code:

---

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

---

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??

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.

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?

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.

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

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