Insert new row after every other row procedure - an example

[DataFreakFromUtah]

No question here, just a procedure for the archive.

Search criteria:
Insert a new row every other row. Insert a row every second row
Add new row after every other row. Every 2nd row inserter. Insert
alternating
rows. Insert alternate rows.




Sub InsertNewRowsEveryOtherRow()


Dim ValueInput As Integer
On Error Resume Next

ValueInput = InputBox("Enter # of alternating rows you would like
to insert.", "Insert Alternating Rows")
If ValueInput = False Then
Exit Sub
End If
If ValueInput > 0 Then
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert

' 'Option to color newly inserted row here:
' With Selection.EntireRow.Interior
' .ColorIndex = 15
' End With

Do Until myvar = ValueInput - 1
ActiveCell.Offset(2, 0).Select
Selection.EntireRow.Insert
'Option to color newly inserted row here:
' With Selection.EntireRow.Interior
' .ColorIndex = 15
' End With
myvar = myvar + 1
Loop
End If
End Sub

 

[Dick Kusleika]

Here's another one if you don't want the ActiveCell to change

Sub InsertAlternating()

Dim lNum As Long
Dim sTtl As String
Dim sMsg As String
Dim lRow As Long

sTtl = "Insert Alternating Rows"
sMsg = "Enter # of alternating rows you would like to insert."

lNum = Application.InputBox(sMsg, sTtl)

If CBool(lNum) <> False And lNum > 0 Then

For lRow = ((lNum * 2) - 1) To lNum Step -1
With ActiveCell.Offset(lRow - lNum + 1).EntireRow
.Insert
.Offset(-1).Interior.ColorIndex = 15
End With
Next lRow

Else
Exit Sub
End If

End Sub

 

[DataFreakFromUtah]

This version inserts alternating rows starting at row 1
and inserts X number of new alternating rows
as per the value returned in the prompt. Note this was modified
from
a previous post on the archive.



Sub InsertNewRowsEveryOtherRowV2()
'This inserts alternating rows starting at row 1
' and inserts X number of new alternating rows
'as per the value returned in the prompt

Dim ValueInput As Integer
Dim iRowNo As Integer

On Error Resume Next

ValueInput = InputBox("Enter # of alternating rows you would like
to insert. Note: this procedure starts at row 1 and inserts
alternating new rows to the number you enter.", "Insert Alternating
Rows")

With ActiveSheet
For iRowNo = ValueInput To 1 Step -1
With .Rows(iRowNo)
.Insert Shift:=xlDown
'note: option to color new rows if desired.
.Interior.ColorIndex = 15
End With
Next iRowNo
End With
End Sub