Force a user to select the entire row from row number

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
Can somebody help a bit please, I have cobbled together the below code to allow the user to insert extra rows. But I have a couple of problems.

1. I need be able to force the user to select the entire row, because at the moment if they select a cell not the row, the code just inserts a copy the active cell. I did try “ActiveCell.EntireRow.Copy” but this errored out on the next line “Selection.Insert Shift:=xlDown”.

2. The other part I would like to achieve is I would like to put something in column O like (do not insert rows here) so the code would check for this value and prevent any rows being entered, with a msgbox stating that you cannot insert rows here. This will enable me to protect parts of the sheet from the user inserting rows.

Any help is much appreciated

Code:
Sub AddRows()

    Dim n As Integer
    Dim Ans As Variant
'    On Error Resume Next

ActiveSheet.Unprotect
 Ans = MsgBox("Have you selected the entire row where you want to add the extra rows", vbYesNo)
 If Ans = vbYes Then

    n = InputBox("How many rows do you require?")
        If n >= 1 Then
            For numtimes = 1 To n
              Selection.Copy
    Selection.Insert Shift:=xlDown

Next
End If
ActiveSheet.Protect

Else
ActiveSheet.Protect
   Exit Sub
   End If
End Sub
 

Some videos you may like

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,014
Office Version
2016
Platform
Windows
Re point 1, try replacing this :
Code:
n = InputBox("How many rows do you require?")
If n >= 1 Then
    For numtimes = 1 To n
        Selection.Copy
        Selection.Insert Shift:=xlDown
    Next
End If
With this :
Code:
n = InputBox("How many rows do you require?")
Selection.Resize(n).EntireRow.Copy
Selection.EntireRow.Insert
And this can be removed :
Code:
Ans = MsgBox("Have you selected the entire row where you want to add the extra rows", vbYesNo)
If Ans = vbYes Then
 
Last edited:

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
Thanks footoo that works brilliantly
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,014
Office Version
2016
Platform
Windows
Here's the whole revised macro :
Code:
Sub AddRows()
Dim n As Integer
ActiveSheet.Unprotect
n = InputBox("How many rows do you require?")
Selection.Resize(n).EntireRow.Copy
Selection.EntireRow.Insert
ActiveSheet.Protect
End Sub
You might want to add some error handling for the input box.
 
Last edited:

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
1,996
OK not as tidy as footoo's but done it now

Code:
Sub AddRows()


    Dim n As Integer
    
    If Cells(ActiveCell.Row, "O") <> "Do Not Insert" Then
        ActiveSheet.Unprotect
        n = InputBox("How many rows do you require?")
        
        If n >= 1 Then
            ActiveCell.EntireRow.Copy
            Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(n, 0)).EntireRow.Insert Shift:=xlDown
            Application.CutCopyMode = False
        End If
        ActiveSheet.Protect
    Else
        MsgBox "Insertion not allowed", vbCritical, "Error"
    End If
End Sub
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,014
Office Version
2016
Platform
Windows
With some error handling added for the selection and the input box (but without the column O bit) :
Code:
Sub AddRows()
Dim n As Variant


If TypeName(Selection) <> "Range" Then
    MsgBox "Select a worksheet cell."
    Exit Sub
ElseIf Selection.Rows.Count > 1 Then
    MsgBox "Select in one row only."
    Exit Sub
ElseIf Selection.Row < 2 Then 'Assuming row 1 is a header row
    MsgBox "The selection must not be in the header row(s)"
End If


Application.DisplayAlerts = False
n = Application.InputBox(Prompt:="How many rows do you require?", Type:=1)
Application.DisplayAlerts = True
If TypeName(n) = "Boolean" Or n = 0 Then Exit Sub
n = Val(n)


ActiveSheet.Unprotect
Selection.Resize(n).EntireRow.Copy
Selection.EntireRow.Insert
ActiveSheet.Protect
End Sub
 
Last edited:

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,014
Office Version
2016
Platform
Windows
You might also want to restrict the number of rows to add :
Code:
Sub AddRows()
Dim n As Variant


If TypeName(Selection) <> "Range" Then
    MsgBox "Select a worksheet cell."
    Exit Sub
ElseIf Selection.Rows.Count > 1 Then
    MsgBox "Select in one row only."
    Exit Sub
ElseIf Selection.Row < 2 Then 'Assuming row 1 is a header row
    MsgBox "The selection must not be in the header row(s)"
End If


Application.DisplayAlerts = False
n = Application.InputBox(Prompt:="How many rows do you require?", Type:=1)
Application.DisplayAlerts = True
If TypeName(n) = "Boolean" Or n = 0 Then Exit Sub
n = Val(n)
[COLOR=#ff0000]If n > 99 Then 'To restrict the maximum number of rows to add[/COLOR]
[COLOR=#ff0000]    MsgBox "Enter a number less than 100"[/COLOR]
[COLOR=#ff0000]    Exit Sub[/COLOR]
[COLOR=#ff0000]End If[/COLOR]


ActiveSheet.Unprotect
Selection.Resize(n).EntireRow.Copy
Selection.EntireRow.Insert
ActiveSheet.Protect
End Sub
 
Last edited:

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
Thanks for all your assistance
All working OK apart from I am not getting the msgbox "Insertion not allowed" up when I try to enter rows where I have Do not insert Rows in column O, although it is preventing me from inserting any rows, it just exits the sub.

It does however pop up if I select vbno from the Ans = MsgBox("Have you selected the entire row where you want to add the extra rows", vbYesNo)

Code below


Code:
Sub AddRows()

    Dim n As Integer
    Dim Ans As Variant
'    On Error Resume Next

If Cells(ActiveCell.Row, "O") <> "Do not insert Rows" Then
        Ans = MsgBox("Have you selected the row where you want to add the extra rows", vbYesNo)
            If Ans = vbYes Then
             ActiveSheet.Unprotect
             n = InputBox("How many rows do you require?")
        If n >= 1 Then
            For numtimes = 1 To n
        Selection.Resize(n).EntireRow.Copy
    Selection.EntireRow.Insert
Next
   Application.CutCopyMode = False
End If
ActiveSheet.Protect
Else
    MsgBox "Insertion not allowed", vbCritical, "Error"
   End If
   End If
End Sub
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,014
Office Version
2016
Platform
Windows
The code in post # 8 is not the same as has been suggested.
For example, the changes you have made means that if the input box contains 5 (say), 25 rows (i.e. 5 times 5) get inserted.
 

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
Apologies Footoo
Got it now
Thanks for everything
 

Watch MrExcel Video

Forum statistics

Threads
1,099,646
Messages
5,469,904
Members
406,674
Latest member
melley

This Week's Hot Topics

Top