Insert Row Under current row (with formulas/formatting)

[dale303]

I've got a sheet that gets appended to regularly but have to do a lot
of fiddling to make sure the formatting is correct, calculated fields
get added and chart series ranges collect all the data every time I add
a new row.

The insert (row) command seems to take care of all of this but it
inserts the empty row above the current row. As I'm always appending
data to the sheet, I would prefer this to be below the current row.

I've tried adding a dummy row under all the data containing the
formulas and formatting I need but unfortunately I get formula errors
and it screws up my chart.

So, is there a way to insert a row under the currently selected row
that copies the formulae, formatting, etc?

 

[Trevor Shuttleworth]

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