Re: insert row with formula etc carried from above

Giganews Newsgroups
Subject: Re: insert row with formula etc carried from above
Posted by:  Trevor Shuttleworth (Trev…@Shucks.demon.co.uk)
Date: Sun, 7 May 2006

the following routines were written to add a row above or below the "active"
row, copy any formulae and formats and add some borders and fonts, etc.  May
not be exactly what you want but they should set you off in the right
direction:

Option Explicit
Option Private Module

' ===== ===== ===== ===== ===== ===== ===== ===== ===== =====
Sub InsertAbove()
' ===== ===== ===== ===== ===== ===== ===== ===== ===== =====

Dim BaseCell As Range
Dim BaseRange As Range
Dim BaseRow As Long
Dim FirstCell As Long
Dim LastCell As Long
Dim c As Range

Set BaseCell = ActiveCell
BaseRow = BaseCell.Row
LastCell = Cells(1, Columns.Count).End(xlToLeft).Column

Set BaseRange = Range(Cells(BaseRow, 1), Cells(BaseRow, LastCell))

Application.ScreenUpdating = False

BaseCell.EntireRow.Insert

For Each c In BaseRange
    If c.HasFormula Then
        c.Offset(-1, 0).FormulaR1C1 = c.FormulaR1C1
        c.Copy
        c.Offset(-1, 0).PasteSpecial Paste:=xlFormats
        Application.CutCopyMode = False
    End If
Next 'c

Cells(BaseRow, 1).Select

With BaseRange.Offset(-1, 0)
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Interior.ColorIndex = xlNone
    .Font.ColorIndex = 0
    .Font.Name = "Arial"
    .Font.Size = 8
End With

Application.ScreenUpdating = True

End Sub

' ===== ===== ===== ===== ===== ===== ===== ===== ===== =====
Sub InsertBelow()
' ===== ===== ===== ===== ===== ===== ===== ===== ===== =====

Dim BaseCell As Range
Dim BaseRange As Range
Dim BaseRow As Long
Dim FirstCell As Long
Dim LastCell As Long
Dim c As Range

Set BaseCell = ActiveCell
BaseRow = BaseCell.Row
LastCell = Cells(1, Columns.Count).End(xlToLeft).Column

Set BaseRange = Range(Cells(BaseRow, 1), Cells(BaseRow, LastCell))

Application.ScreenUpdating = False

BaseCell.Offset(1, 0).EntireRow.Insert

For Each c In BaseRange
    If c.HasFormula Then
        c.Offset(1, 0).FormulaR1C1 = c.FormulaR1C1
        c.Copy
        c.Offset(1, 0).PasteSpecial Paste:=xlFormats
        Application.CutCopyMode = False
    End If
Next 'c

Cells(BaseRow, 1).Offset(1, 0).Select

With BaseRange.Offset(1, 0)
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Interior.ColorIndex = xlNone
    .Font.ColorIndex = 0
    .Font.Name = "Arial"
    .Font.Size = 8
End With

Application.ScreenUpdating = True

End Sub

' ===== ===== ===== ===== ===== ===== ===== ===== ===== =====

Regards

Trevor

"HenryAlive" <HenryAli…@discussions.microsoft.com> wrote in message
news:AD799197-F28D-436D-804C-44877E5409…@microsoft.com...
>I need to insert rows in a wat that the inserted row carries the format and
> formulae of the row immediately above. The key part of the formating above
> is
> 2 cells merged into one [because of stff elsewhere in the worksheet] and
> the
> formulae above. This is a form to be used by others and I am inserting
> into a
> protected sheet with the insert rows box in Protection checked.
>
> This sort of thinh used to work in Supercalc [remember that one] but
> apparently not in Excel
>
> Thanks

Replies

None

In response to

insert row with formula etc carried from above posted by HenryAlive on Sun, 7 May 2006