Adjusted for protected (but not password protected) worksheets
- see below
--
Gary Brown

If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".


"jgray" wrote:

Gary,

That worked out SO well! I have been able to apply it to a couple different
projects I had been working on. I guess a follow up question would be... is
it possible to adapt that code so that it may be used on a protected sheet?
THANKS!


'/=======Start of Code==========================/
Sub InsertRowsAndFillFormulas()
'adds desired # of lines below the current line and
' copies the formulas to that/those lines
'added selection of more than one worksheet
' - Gary L. Brown
' - Kinneson Corp. 01/17/2001
' - modification from thread discussion in
' Microsoft.Public.Excel.Programming newsgroup
' on 01/17/2001
' Insert Rows -- 1997/09/24 Mark Hill
' The original macro is described in
' http://www.geocities.com/davemcritch...l/insrtrow.htm
Dim blnProtectContents As Boolean
Dim blnProtectDrawingObjects As Boolean
Dim blnProtectScenarios As Boolean
Dim vRows As Long, i As Long
Dim strAddress As String, shts() As String
Dim sht As Worksheet

'set default for whether worksheet is protected or not
blnProtectContents = False
blnProtectDrawingObjects = False
blnProtectScenarios = False
strAddress = Selection.Address

'rev. 2005-08-02 - check if worksheet unprotected
' if it's protected, get various information
If Application.ActiveSheet.ProtectContents = True Then
blnProtectContents = True
If Application.ActiveSheet.ProtectDrawingObjects = True Then
blnProtectDrawingObjects = True
End If
If Application.ActiveSheet.ProtectScenarios = True Then
blnProtectScenarios = True
End If
ActiveSheet.Unprotect
If Application.ActiveSheet.ProtectContents = True Then
'not unprotected so stop process
Exit Sub
End If
End If

' row selection based on active cell --
' rev. 2000-09-02 David McRitchie
ActiveCell.EntireRow.Select
vRows = _
Application.InputBox(prompt:= _
"How many rows do you want to add?" & vbCr & vbCr & _
"Rows will be added UNDERNEATH this row.", _
Title:="Add Rows", _
Default:=1, Type:=1) 'type 1 is number

If vRows = False Then Exit Sub
'if you just want to add cells and not entire rows
' then delete ".EntireRow" in the following line

ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
Windows(1).SelectedSheets.Count)
i = 0

'insert rows on grouped worksheets
' rev. 2001-01-17 Gary Brown
For Each sht In _
Application.ActiveWorkbook.Windows(1).SelectedShee ts
Sheets(sht.name).Select
i = i + 1
shts(i) = sht.name

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 remove the non-formulas -- 1998/03/11 Bill Manville
Selection.Offset(1).Resize(vRows).EntireRow. _
SpecialCells(xlConstants).ClearContents
Next sht

'reselect original group - Dave McRitchie 01/17/2001
' and go back to original selected cells
Worksheets(shts).Select
Range(strAddress).Select

'set worksheet back to original protected/unprotected state
ActiveSheet.Protect DrawingObjects:=blnProtectDrawingObjects, _
Contents:=blnProtectContents, Scenarios:=blnProtectScenarios

End Sub
'/=======End of Code==========================/