Consulting

Results 1 to 3 of 3

Thread: Insert New Rows Between Rows

  1. #1

    Insert New Rows Between Rows

    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:

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

    Now, what I need to do is this:

    [VBA]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
    [/VBA]
    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?

  2. #2
    VBAX Regular
    Joined
    Feb 2012
    Posts
    31
    Location
    See if this is any good for you. You highlight the rows you want to copy and insert then enter how many times.

    [vba]
    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
    [/vba]
    ------------------------------------------------

    Thanks For All Your Help

    Windows 7

    Excel 2010

    Any codes I provide please try on a copy of your workbook first as these cannot be undone!

    To get the most precise answer, it is best to upload/attach a sample workbook (sensitive data scrubbed/removed/changed) that contains an example of your raw data on one worksheet, and on another worksheet your desired results.

    The structure and data types of the sample workbook must exactly duplicate the real workbook. Include a clear and explicit explanation of your requirements.

  3. #3
    Pretty neat solution. I'll give it a try
    Thanks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •