Insert row and copy formulas

[Hugh]

I have used David McRitchie's macro to insert rows and copy formulas from the
row above. I then edited the macro to first unprotect the sheet and then
protect it at the end. However, if a user invokes the macro and then cancels
it when the dialogue box appears the sheet is not protected.

How would I go about modifying the code to protect the sheet if the macro is
canceled at the dialogue box?

Here is the code, which is basically copied directly from David's website:

'-- this macro shows on Tools, Macro..., Macros (Alt+F8) dialog
Call InsertRowsAndFillFormulas
End Sub

Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)
' Documented: http://www.mvps.org/dmcritchie/excel/insrtrow.htm
' Re: Insert Rows -- 1997/09/24 Mark Hill <[email protected]>
' row selection based on active cell -- rev. 2000-09-02 David McRitchie
ActiveSheet.Unprotect
Dim x As Long
ActiveCell.EntireRow.Select 'So you do not have to preselect entire row
If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"How many rows do you want to add?", Title:="Add Rows", _
Default:=1, Type:=1) 'Default for 1 row, type 1 is number
If vRows = False Then Exit Sub
End If

'if you just want to add cells and not entire rows
'then delete ".EntireRow" in the following line

'rev. 2001-01-17 Gary L. Brown, programming, Grouped sheets
Dim sht As Worksheet, shts() As String, i As Long
ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
Windows(1).SelectedSheets.Count)
i = 0
For Each sht In _
Application.ActiveWorkbook.Windows(1).SelectedSheets
Sheets(sht.Name).Select
i = i + 1
shts(i) = sht.Name

x = Sheets(sht.Name).UsedRange.Rows.Count 'lastcell fixup

Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
Resize(rowsize:=vRows).Insert Shift:=xlDown

Selection.AutoFill Selection.Resize( _
rowsize:=vRows + 1), xlFillDefault

On Error Resume Next 'to handle no constants in range -- John McKee
2000/02/01
' to remove the non-formulas -- 1998/03/11 Bill Manville
Selection.Offset(1).Resize(vRows).EntireRow. _
SpecialCells(xlConstants).ClearContents
Next sht
Worksheets(shts).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowSorting:=True,
AllowFiltering:=True _
, AllowUsingPivotTables:=True
End Sub

Thanks!

 

[Dave Peterson]

It looks like you could just move the .protect line to after the section that
asks that question...(after the "End if" line).

But I'm confused.

Did you really want to cycle through all the sheets in the grouped sheets?

Did you want to unprotect each of those sheets, do the insert, then reprotect
each sheet?

Are you sure you want to base the insertion on the selection on that sheet?

 

[Hugh]

I should have added that this my first attempt with macros and I don't really
understand the code.

The macro appears to work the way I want it to, except for my initial
question. To answer your third question, yes. It is very important that the
row is inserted based on the selection.

As far as the other two questions, the only sheet that I care about is the
active one. I did not realize that the code is looking at more than the
active sheet. Which section of the code are you referring to?

Also, I moved the protect portion as you suggested and I get a run time
error stating that the cells are protected. It runs everything to this line:


Selection.AutoFill Selection.Resize( _
rowsize:=vRows + 1), xlFillDefault

 

[Dave Peterson]

If you have multiple sheets grouped, then this portion:

will loop through those grouped sheets.

Since you don't want that, your code could be simplified:

Option Explicit
Sub testme()
Call InsertRowsAndFillFormulas
End Sub
Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)

Dim myCell As Range

If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"How many rows do you want to add?", _
Title:="Add Rows", _
Default:=1, Type:=1)

If vRows = False Then
Exit Sub
End If
End If

ActiveSheet.Unprotect

Set myCell = ActiveCell

myCell.Offset(1).Resize(vRows).EntireRow.Insert

myCell.EntireRow.AutoFill _
Destination:=myCell.Resize(vRows + 1).EntireRow, _
Type:=xlFillDefault

On Error Resume Next
myCell.Offset(1, 0).Resize(vRows).EntireRow. _
SpecialCells(xlConstants).ClearContents
On Error GoTo 0

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
End Sub

 

[Hugh]

That works exactly like i want it to. Thanks a million, you just made my
life at work a million times easier.

 

[Dave Peterson]

Glad it worked ok.

That works exactly like i want it to. Thanks a million, you just made my
life at work a million times easier.