Inserting a new Row that copies formulas from above

[SuzNZ]

hi

I have a s/sheet v 2010 that is a form for users to fill in - so it's protected except for some cells where they need to enter data.

My Problem is that in some sections I have a unknowen quatity of rows that the user may need - so I want them to be able to easily insert new rows - but have the instered Rows have the same formulas and formatting as the ones above

any idea??

thanks heaps in advance
Cheers
Suz

 

[Nalani]

I use this in Excel 2003 & 2007. Not familar with 2010 but would think it should work.

Sub InsertRowsAndFillFormulas_caller()
  '-- this macro shows on Tools, Macro..., Macros (Alt+F8) dialog
  Call InsertRowsAndFillFormulas
End Sub
 
Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)
   ' row selection based on active cell
   Dim x As Long
   Application.EnableEvents = False
'   ActiveSheet.Unprotect Password:=Sheet6.Range("IV1").Value
   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
   Dim sht As Worksheet, shts() As String, i As Integer
   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
    ' to remove the non-formulas
    Selection.Offset(1).Resize(vRows).EntireRow. _
     SpecialCells(xlConstants).ClearContents
   Next sht
   Worksheets(shts).Select
   Application.CalculateFull
   Application.EnableEvents = True
'ActiveSheet.Protect Password:=Sheet6.Range("IV1").Value, _
'        DrawingObjects:=True, Contents:=True, Scenarios:=True _
'        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
'        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
'        :=True, AllowDeletingColumns:=True, AllowDeletingRows:=True
End Sub

Insert ALL in a standard module.

Do on a copy to test.

Notice that the Unprotect and Protect lines are commented out. Up to you if you want to activate them. And if so change the Password.