insert a row for every 20,000 th row?

[elaine]

Hi all,

Jsut wondering whether theres a worksheet function or code that could
automatically insert a row for every 20,000 row? or just every X
row??

Thanks for your help

Elaine.

 

[Bob Phillips]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Const INSERT_ROW As Long = 5 '<=== CHANGE TO SUIT
Dim i As Long
Dim iLastRow As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
iLastRow = iLastRow + INSERT_ROW - iLastRow Mod INSERT_ROW
For i = iLastRow To 1 Step -INSERT_ROW
Rows(i).Insert
Next i

End With

End Sub



--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[NickHK]

Elaine,
Adjust as needed:

Dim i As Long

Const ROWJUMP As Long = 20000

For i = 1 To Rows.Count Step ROWJUMP
Rows(i & ":" & i).Insert Shift:=xlDown
'Just to see where rows added
Rows(i & ":" & i).Interior.ColorIndex = 10
Next

NickHK

 

[elaine]

Thank you guys, they work perfectly. Just wondering is there a way I
can insert X rows every Y rows?

Thanks for your help

elaine.

 

[elaine]

Thanks Bob!
It does exactly what i wanted to!

Thanks so much!

 

[NickHK]

Elaine,
Try this:

Private Sub CommandButton1_Click()
RowInsertion Range("A10"), 100, 10
End Sub

Private Sub RowInsertion(argStartCell As Range, RowsToJump As Long, Optional
RowsToInset As Long = 1)
Dim i As Long

For i = argStartCell.Row To Rows.Count Step RowsToJump
Rows(i & ":" & i + RowsToInset - 1).Insert Shift:=xlDown
'Just to see where rows added
Rows(i & ":" & i + RowsToInset - 1).Interior.ColorIndex = 10
Next

End Function

NickHK

 

[elaine]

Hi NickHK,

your code is taking a long time to run, i guess it is trying to add
rows to the whole spreadsheet (ie ~1 Million rows). Is it possible if
it could jsut add rows to the range that has data??

Thanks very much.
Elaine.

 

[Bob Phillips]

Private Sub RowInsertion(argStartCell As Range, RowsToJump As Long, Optional
RowsToInset As Long = 1)
Dim i As Long

For i = argStartCell.Row To Cells(Rows.Count,
argStartCell.Column).End(xlUp).Row Step RowsToJump
Rows(i & ":" & i + RowsToInset - 1).Insert Shift:=xlDown
'Just to see where rows added
Rows(i & ":" & i + RowsToInset - 1).Interior.ColorIndex = 10
Next


--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)