Insert rows for multiple selected rows

**JN12345** · 05-24-2018, 11:29 AM

Hello all,

Can someone modify this code? It does not insert the specified rows in the input box for each selected row, just for one.

Sub test()
  Dim rowcount As Integer
  zeilenanzahl = InputBox("how many rows?")
  Range(ActiveCell, ActiveCell.Offset((rowcount - 1), 0)).EntireRow.Insert
  Cancel = True
End Sub

Best,
JN

**mjr veverka** · 05-24-2018, 04:16 PM

Originally Posted by JN12345

1. ... for each selected row ...
2. Dim rowcount As Integer
3. zeilenanzahl = InputBox ...
4. Cancel = True

1. Do you want to insert rows in the selected range, or starting from the active cell ? These are two different things.
If you select the range from "A4" to "A1" the active cell will be "A4", if from "A1" to "A4" the active cell will be "A1".
2. Where is "rowcount" calculated ? No calculations.
3. Where is the "zeilenanzahl" declaration and what for is it ?
4. Where is it from ?

Try:
(rows will be inserted starting from the active cell - two variants)

Option Explicit

Sub test()
Dim riadok As Long

    On Error Resume Next
    riadok = Abs(CLng(InputBox("Number of rows", "how many rows ?", "1")))
    If Err.Number <> 0 Then MsgBox "An error occured": Exit Sub
    On Error GoTo 0
    'Rows(ActiveCell.Row + 1 & ":" & ActiveCell.Row + riadok).Insert Shift:=xlDown
    'or
    Rows(ActiveCell.Row & ":" & ActiveCell.Row + riadok - 1).Insert Shift:=xlDown
End Sub

**JN12345** · 05-24-2018, 04:57 PM

Hello Porucha,

Thank you for your reply. I really appreciate it. I'll try your code asap.

Unfortunately, when I translated the code I made a typo, sorry for that. The code looks actually like this:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim rowcount As Integer
  rowcount = InputBox("how many rows?")
  Range(ActiveCell, ActiveCell.Offset((rowcount - 1), 0)).EntireRow.Insert
  Cancel = True
End Sub

This code inserts the specified amount of rows after a selected cell. It works perfectly fine. However, I need a bit something else.
1. I would like to select several cells in column A at the same time (strg + select). Those cells can be anywhere in column A, e.g. A21, A34, A45 and so on
2. After selecting the cells I would like to insert after each selected cell a specific amount of rows. The number of rows I would put into the message box. As mentioned before, with the code above I can only insert rows after one selected cell, which would make my doing very time consuming. I read that "activecell" can only be just one row. But is there a workaround?

Let me know if you need further clarifications.

Best,
JN

**mjr veverka** · 05-24-2018, 06:29 PM

Originally Posted by JN12345

1a. ...Worksheet_BeforeDoubleClick ...

1b. ... to select several cells ... at the same time ...
2. After selecting the cells... to insert after ... selected cell a specific amount of rows ...

1a,b.

How do you want to do this with this procedure ?
If you select some cells, two ... three ... four cells etc. and then you double-click, then you haven't multiple-selected cells but only one-selected cell, the one you double click. One action excludes this other action.

2. Inserting rows starting from the first cell under the active cell:

    Rows(ActiveCell.Row + 1 & ":" & ActiveCell.Row + rows_from_InputBox).Insert Shift:=xlDown

**JN12345** · 05-25-2018, 02:48 AM

Ok, thank you. I understand that it only works with one selected cell. But is there a workaround to insert the cells right after all selected cells?

In the example below I would like to insert the rows I specified in the input box for all highlighted cells and not only for "UT20". Is this possible with vba?

Untitled.png

**mjr veverka** · 05-25-2018, 04:18 PM

Using the menu from the right mouse button:

1. ThisWorkbook module

Option Explicit

Private Sub Workbook_Deactivate()
Dim ctrl As CommandBarControl

    On Error Resume Next
    For Each ctrl In Application.CommandBars("Cell").Controls
        If ctrl.Tag = "Delete_after" Then ctrl.Delete
    Next
End Sub
 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim ctrl As CommandBarControl
Dim myPopUp As CommandBarButton

    If TypeName(Sh) = "Worksheet" Then
        On Error Resume Next
        For Each ctrl In Application.CommandBars("Cell").Controls
            If ctrl.Tag = "Delete_after" Then ctrl.Delete
        Next
        On Error GoTo the_end
        Set myPopUp = Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
        With myPopUp
            .Caption = "Inserting rows in selection areas"
            .OnAction = "insert_rows"
            .FaceId = 133
            .Tag = "Delete_after"
        End With
        Set myPopUp = Nothing
        Application.CommandBars("Cell").Controls(2).BeginGroup = True
    End If
    
Exit Sub
the_end: MsgBox "Error - End", vbOKOnly, "Info"
End Sub

2. Standard module, Module1:

Option Explicit
Option Private Module

Sub insert_rows()
Dim nmbrrws As Long, i As Long, nmbrArea As Long

    On Error Resume Next
    nmbrrws = Abs(CLng(InputBox("Enter the number of rows:", "How many rows to add ?", "1")))
    If Err.Number <> 0 Then MsgBox "An error occured", vbOKOnly, "Info": Exit Sub
    On Error GoTo the_end
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlManual
    
    nmbrArea = Selection.Areas.Count
    
    For i = nmbrArea To 1 Step -1
        Rows(Selection.Areas(i).Cells(1).Row + 1 & ":" & Selection.Areas(i).Cells(1).Row + nmbrrws).Insert Shift:=xlDown
    Next
    
    Application.Calculation = xlAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
Exit Sub
the_end: MsgBox "Error - End", vbOKOnly, "Info"
End Sub