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

 

[Bagsy]

OK ran into a bit of an issue
Is there any way I can include

' Ans = MsgBox("Have you selected the row where you want to ads the extra rows", vbYesNo)
' If Ans = vbYes Then
I need this because the user will need to select where they would like to insert the rows

Also works OK if I enter 1 into the input box, but if I select more than 1 say 10 what happens is it copies 10 rows then inserts the 10. I need it just to copy the 1 row and insert it 10 times
Appreciate any assistance

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]

Selection.EntireRow.Copy
Selection.Resize(n).EntireRow.Insert

Your code is still wrong - you haven't removed the loop.

 

[footoo]

Try this :

Sub AddRows()
Dim n As Variant, Ans 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


If Cells(ActiveCell.Row, "O") = "Do not insert Rows" Then
    MsgBox "Insertion not allowed", vbCritical, "Error"
    Exit Sub
End If


Ans = MsgBox("Is your selection in the row where you want to add the extra rows", vbYesNo)
If Ans = vbNo Then Exit Sub


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)
If n > 99 Then 'To restrict the maximum number of rows to add
    MsgBox "Enter a number less than 100"
    Exit Sub
End If
ActiveSheet.Unprotect
Selection.EntireRow.Copy
Selection.Resize(n).EntireRow.Insert
ActiveSheet.Protect
End Sub

 

[Bagsy]

OK thanks Footoo, lost the plot a bit
Is there any way I can include

' Ans = MsgBox("Have you selected the row where you want to ads the extra rows", vbYesNo)
' If Ans = vbYes Then
I need this because the user will need to select where they would like to insert the rows

Sub AddRows()

    Dim n As Integer
    Dim Ans As Variant

If Cells(ActiveCell.Row, "O") <> "Do not insert Rows" Then

ActiveSheet.Unprotect
    n = InputBox("How many rows do you require?")
        Selection.EntireRow.Copy
            Selection.Resize(n).EntireRow.Insert
        If n > 50 Then 'To restrict the maximum number of rows to add
    MsgBox "Enter a number less than 50"
    
    Exit Sub
End If

   Application.CutCopyMode = False
ActiveSheet.Protect
Else
    MsgBox "Insertion not allowed", vbCritical, "Error"
   End If
End Sub

 

[Bagsy]

Footoo thanks for all your help I think I have got it now, posting code in case it helps somebody else out

Sub AddRows()

    Dim n As Integer
    Dim Ans As Variant

If Cells(ActiveCell.Row, "O") <> "Do not insert Rows" Then
    Ans = MsgBox("Have you selected the row where you want to insert the extra rows", vbYesNo)
If Ans = vbYes Then

ActiveSheet.Unprotect
n = InputBox("How many rows do you require?")
    If n > 50 Then 'To restrict the maximum number of rows to add
MsgBox "Enter a number less than 50"
Exit Sub
End If

Selection.EntireRow.Copy
    Selection.Resize(n).EntireRow.Insert
   Application.CutCopyMode = False
ActiveSheet.Protect
Else
    MsgBox "Insertion not allowed", vbCritical, "Error"
End If
Else
    MsgBox "Insertion not allowed", vbCritical, "Error"
End If
End Sub

 

[footoo]

Better to change this :

Selection.Resize(n).EntireRow.Insert

To this :

Selection.EntireRow.Resize(n).Insert

Why don't you try the macro per post # 13 ?
It avoids a number of potential run-time errors.

 

[Bagsy]

Thanks for all your help Footo
I have changed that line of code you suggested.
I will look at the macro macro per post # 13 the reason I didn’t was I had gone down a root I was sort of comfortable with.
I have more than 1 header row. I have 13 header rows at the top with formulas in and 46 rows at the bottom of the page with formulas in (these obviously update as rows are inserted). This leaves a section of 69 rows in the centre of the page, which I need the user to insert rows if required.
Now I have got the code working, the pressure is off I will spend some time trying the macro per post # 13, it’s all a little easier when you have time.
Thanks for everything.

 

[Bagsy]

Footoo
Just had a go with the code you wrote at post # 13, works absolutely brilliantly.
Thank you

 

[footoo]

I have more than 1 header row. I have 13 header rows at the top with formulas in and 46 rows at the bottom of the page with formulas in (these obviously update as rows are inserted).

To prevent insertion of rows within the formula rows at the bottom, insert a name for these rows (let's say : Last_Rows). Then :

Sub AddRows()
Dim n As Variant, Ans 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
[COLOR=#ff0000]ElseIf Selection.Row < 14 Then
    MsgBox "The selection must not be in the header rows"
ElseIf Not Intersect(Selection, Range("Last_Rows")) Is Nothing Then
    MsgBox "The selection must not be in the formula rows at the bottom of the sheet,"
    Exit Sub[/COLOR]
End If
 
If Cells(ActiveCell.Row, "O") = "Do not insert Rows" Then
    MsgBox "Insertion not allowed", vbCritical, "Error"
    Exit Sub
End If
 
Ans = MsgBox("Is your selection in the row where you want to add the extra rows", vbYesNo)
If Ans = vbNo Then Exit Sub
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 > 49 Then
    MsgBox "Enter a number less than 50"[/COLOR]
    Exit Sub
End If
ActiveSheet.Unprotect
Selection.EntireRow.Copy
Selection.Resize(n).EntireRow.Insert
ActiveSheet.Protect
End Sub

 

[Bagsy]

Thanks Footo
Will give it a go