inserting a row(empty) afther each 4 rows of my data

hi i want a code that do like this record macro and will continue up to end
please send me acode

Code:

---

'
' Macro10 Macro
'
' Keyboard Shortcut: Ctrl+b
'
    Rows("5:5").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("10:10").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("15:15").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("20:20").Select
Attachment 1750Attachment 1751
    End Sub

---

Suppose there are some data in column A ...
Try this code

Code:

---

Sub InsertEmptyRow()
    Dim LR As Long, I As Long, X As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    X = Int(LR / 4) + LR
    For I = 5 To X Step 5
        Cells(I, 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next I
End Sub

---

Same idea as KingTamo's code, but a little more compact...

Code:

---

Sub Test()
  Dim R As Long
  For R = 5 To Cells(Rows.Count, "A").End(xlUp).Row Step 5
    Rows(R).Insert
  Next
End Sub

---

Mr. Rick
your code is great but it will not work after while ..
Try to put any numeric values in range("A1:A102") for example .. and test your code
you'll find that the last empty row is row 100 only !!

Quote:

---

Originally Posted by KingTamo

Mr. Rick
your code is great but it will not work after while ..
Try to put any numeric values in range("A1:A102") for example .. and test your code
you'll find that the last empty row is row 100 only !!

---

Good catch! Thanks for catching that... I had forgotten to account for the fact that the last row changes as the rows are inserted which is easily accounted for...

Code:

---

Sub Test()
  Dim R As Long
  For R = 5 To 5 * Cells(Rows.Count, "A").End(xlUp).Row Step 5
    Rows(R).Insert
  Next
End Sub

---

If the OP does not want to watch the screen jumping around, screen updating can be turned off, although then there is no visual feedback as to the macro's progress which may be important if there are a lot of rows to process (I have a fairly fast computer and the wait was quite noticeable for 20,000 rows).

Code:

---

Sub Test()
  Dim R As Long
  Application.ScreenUpdating = False
  For R = 5 To 5 * Cells(Rows.Count, "A").End(xlUp).Row Step 5
    Rows(R).Insert
  Next
  Application.ScreenUpdating = True
End Sub

---

Mr Rick Rothstein
thanks a lot for this great code
I tried your code on my pc as following :
I tried now 1000 rows ... calcuating the time elapsed for my code and yours.
As for my code it takes 1.7 seconds but your code takes 6.6 seconds !!
Here's the codes

Code:

---

Sub InsertEmptyRowKingTamo()
    Dim LR As Long, I As Long, X As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    X = Int(LR / 4) + LR
    For I = 5 To X Step 5
        Cells(I, 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next I
End Sub

Sub InsertEmptyRowRickRothstein()
    Dim R As Long
    For R = 5 To 5 * Cells(Rows.Count, "A").End(xlUp).Row Step 5
        Rows(R).Insert
    Next
End Sub

Sub CodeExecutionTime()
    Dim xStartTime As Double
    Dim xElapsedTime As Double
    xStartTime = Timer()
 
    Call InsertEmptyRowRickRothstein
   
    xElapsedTime = Timer() - xStartTime
        If xElapsedTime < 0# Then
            xElapsedTime = xElapsedTime + 86400#
        End If
    MsgBox "Elasped Time : " & xElapsedTime
End Sub

---

Quote:

---

Originally Posted by KingTamo

Mr Rick Rothstein
thanks a lot for this great code
I tried your code on my pc as following :
I tried now 1000 rows ... calcuating the time elapsed for my code and yours.
As for my code it takes 1.7 seconds but your code takes 6.6 seconds !!

---

Your code does not do what my code does which is why it takes less time... my code inserts entire rows (which is what I read the OP's request to be) whereas your code only inserts blank cells in Column A. Try adding data in Columns A and B and then run your code to see what I mean.

Mr. Rick
I tried this modification and it takes the same period nearby

Code:

---

Sub InsertEmptyRowKingTamo()
    Dim LR As Long, I As Long, X As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    X = Int(LR / 4) + LR
    For I = 5 To X Step 5
        Rows(I).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next I
End Sub

---

While your code still takes the same long period ..

Quote:

---

Originally Posted by KingTamo

Mr. Rick
I tried this modification and it takes the same period nearby

Code:

---

Sub InsertEmptyRowKingTamo()
    Dim LR As Long, I As Long, X As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    X = Int(LR / 4) + LR
    For I = 5 To X Step 5
        Rows(I).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next I
End Sub

---

While your code still takes the same long period ..

---

That is because the modification I did in Message #5 over-compensated for what was actually needed. This should come in at the same timing as your code...

Code:

---

Sub Test()
  Dim R As Long
  For R = 5 To 1.25 * Cells(Rows.Count, "A").End(xlUp).Row Step 5
    Rows(R).Insert
  Next
End Sub

---

And this should be somewhat faster (you can do the same for your code to speed it up as well)...

Code:

---

Sub Test()
  Dim R As Long
  Application.ScreenUpdating = False
  For R = 5 To 1.25 * Cells(Rows.Count, "A").End(xlUp).Row Step 5
    Rows(R).Insert
  Next
  Application.ScreenUpdating = True
End Sub

---

Now it is perfect Mr. Rick
Thanks a lot for your patience and for your great code