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
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

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
 

Some videos you may like

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,013
Office Version
2016
Platform
Windows
Code:
Selection.EntireRow.Copy
Selection.Resize(n).EntireRow.Insert
Your code is still wrong - you haven't removed the loop.
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,013
Office Version
2016
Platform
Windows
Try this :
Code:
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

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
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


Code:
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

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
Footoo thanks for all your help I think I have got it now, posting code in case it helps somebody else out

Code:
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

Well-known Member
Joined
Sep 21, 2016
Messages
3,013
Office Version
2016
Platform
Windows
Better to change this :
Code:
Selection.Resize(n).EntireRow.Insert
To this :
Code:
Selection.EntireRow.Resize(n).Insert
Why don't you try the macro per post # 13 ?
It avoids a number of potential run-time errors.
 
Last edited:

Bagsy

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
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

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
Footoo
Just had a go with the code you wrote at post # 13, works absolutely brilliantly.
Thank you
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,013
Office Version
2016
Platform
Windows
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 :
Code:
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

Active Member
Joined
Feb 26, 2005
Messages
377
Office Version
365
Platform
Windows
Thanks Footo
Will give it a go
 

Watch MrExcel Video

Forum statistics

Threads
1,099,583
Messages
5,469,518
Members
406,656
Latest member
Kriscrawford76

This Week's Hot Topics

Top