PDA

View Full Version : Insert New Rows Between Rows



Pendrant12
04-30-2012, 10:04 AM
Hey guys,
I found out that selecting multiple rows by hand and then inserting rows would result in inserting new rows between the selected rows.
The following macro shows this:

Sub Macro1()
Range("1:1,2:2,3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

Now, what I need to do is this:

Sub test()
'Getting the last Row
Cells(1, 1).Select
lastRow = Selection.End(xlDown).Row
'Building the Selection
For i = 1 To lastRow
selectionString = selectionString & i & ":" & i & ","
Next i
'Removing the last ","
selectionString = Mid(selectionString, 1, Len(selectionString) - 1)
Range(selectionString).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

This is trying to select each row individually to insert rows between the selected rows. As expected, I get the following error as it tries to select the rows:

Run-time error '1004':

Method 'Range' of object 'Global_' failed

I know there are plenty of ways to achieve the same result by creating a simple for-loop and inserting a new row after each row.
This is NOT what I want to do, since this seems to be a lot slower. (I am speaking about 200.000-300.000 rows)
Any ideas no how to get this working without a loop?

dazwm
04-30-2012, 12:05 PM
See if this is any good for you. You highlight the rows you want to copy and insert then enter how many times.


Sub CopyAndInsertRow()
Dim NextRow As Long
Dim NrOfCopies As Long
Dim i As Long

Const NrOfCopiesDefault = 1
Const NrOfCopiesMaximum = 9

Do

On Error Resume Next
NrOfCopies = Application.InputBox(prompt:="How Many Copies Do You Want To Copy & Insert?", _
Title:="# COPIES", Default:=NrOfCopiesDefault, Type:=1)
On Error GoTo 0

If NrOfCopies = 0 Then
MsgBox "No copies made.", vbInformation, "CANCELLED"
Exit Sub
ElseIf NrOfCopies > NrOfCopiesMaximum Then MsgBox "Please Enter Number Of Copies Between 1 and " & NrOfCopiesMaximum, 48, "ERROR"
End If

Loop While NrOfCopies < 1 Or NrOfCopies > NrOfCopiesMaximum

With Selection
NextRow = .Row + .Rows.Count
Rows(NextRow & ":" & NextRow + .Rows.Count * (NrOfCopies) - 1).Insert Shift:=xlDown
.EntireRow.Copy Rows(NextRow & ":" & NextRow + .Rows.Count * (NrOfCopies) - 1)
.Resize(.Rows.Count * (NrOfCopies + 1)).Sort Key1:=.Cells(1, 1)
End With

End Sub

Pendrant12
04-30-2012, 12:44 PM
Pretty neat solution. I'll give it a try :)
Thanks