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

[saied]

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


'
' 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
17501751
End Sub

[KingTamo]

Suppose there are some data in column A ...
Try this 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

[Rick Rothstein]

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

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

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

[Rick Rothstein]

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


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


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

[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 !!
Here's the codes

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

[Rick Rothstein]

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.

[KingTamo]

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

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

[Rick Rothstein]

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

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


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


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

[KingTamo]

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