Force a user to select the entire row from row number

[Bagsy]

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

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

 

[footoo]

Re point 1, try replacing this :

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 :

n = InputBox("How many rows do you require?")
Selection.Resize(n).EntireRow.Copy
Selection.EntireRow.Insert

And this can be removed :

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

 

[Bagsy]

Thanks footoo that works brilliantly

 

[footoo]

Here's the whole revised macro :

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.

 

[gallen]

OK not as tidy as footoo's but done it now

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]

With some error handling added for the selection and the input box (but without the column O bit) :

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

 

[footoo]

You might also want to restrict the number of rows to add :

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

 

[Bagsy]

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

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]

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]

Apologies Footoo
Got it now
Thanks for everything