Insert rows and formulas

[rjplante]

I have a table of data with 20 rows in it. Row 21 calculates the average of each respective column of data. I would like to have a macro to insert a row between row 20 and 21, preserve the formulas from the cell above in the new row and then have the last row be updated to account for the new row in the average formula.

Is this even possible? I thought that when you inserted a row it automatically kept the formulas and would update the average fields.

Thanks for any assistance,

Robert

 

[Nalani]

I found this Macro a long time ago and did not record the Author.

I think it will do what you are asking: It works on the Active cell and copies down Formulas, getting rid of constants.

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

Place both in one module.

 

[rjplante]

This is great thanks for the help!