Insert a New Row

Suppose I have records that use formulas and, when I insert a row, I don't get the formula and formatting.

Can somebody create a kb entry that inserts a new row at the current selection that copies the row above it and removes all but formulas and formatting? Or whatever method is best to accomplish the same thing. And then if someone could get that approved ASAP, I'd REALLY appreciate it!!

If you're going to make the kb entry, post BEFORE you do it so we don't have multiple people writing the same entry.

If you want to approve it, post so we don't...you know. LOL

Hi Anne,

The following should work..

Code:

---

Sub InsRowCopyFormulas()
 Dim AcR As Long, cLL As Range
 AcR = ActiveCell.Row
 Rows(AcR).Insert
 Rows(AcR - 1).Copy Rows(AcR)
 For Each cLL In Intersect(Rows(AcR), ActiveSheet.UsedRange)
  If Left(cLL.FormulaR1C1, 1) <> "=" Then cLL.ClearContents
 Next
End Sub

---

Hey Anne, this is what I use, may not be the best, but it works...

Code:

---

Sub CopyToNewRow()
' Verify user wants to add new row with a copy/paste
    If MsgBox("Are you sure you want to Insert a copied row?", _
        vbYesNo, "Insert copied row") = vbNo Then Exit Sub
' Set range as variable user-input with default as last selection
    Dim NewRow As Range
    Set NewRow = Application.InputBox( _
        "Select or input row (can be an individual cell) to duplicate.", _
        Default:=Selection.Address(False, False), Type:=8)
    If NewRow Is Nothing Then Exit Sub
    [NewRow].EntireRow.Select
        With Selection
            .Copy
            .Insert Shift:=xlDown
        End With
    [NewRow].Select
    Application.CutCopyMode = False
End Sub

---

Hi anne
This should also work.
The reason why I don't have a With Activecell around the 3 lines is that activecell changes when a row is inserted

Code:

---

Sub InsertARow()
  'make new row
  ActiveCell.EntireRow.Insert Shift:=xlDown
  'copy the row above
  ActiveCell.Offset(-1, 0).EntireRow.Copy Cells(ActiveCell.Row, 1)
  'clear every cell in the new line that does not have a formula
  ActiveCell.EntireRow.SpecialCells(xlCellTypeConstants, 23).ClearContents
End Sub

---

br
Tommy Bak

Thanks, Tommy! I'll check it out.

Nice one Tommy

just a couple of small comments on your use of SpecialCells
1) If there are no constants then an error will be returned. I suggest you add a On Error Resume Next as below
2) Anne do you see =10 as a formula? The SpecialCells approach will leave this in place

Code:

---

Sub InsertARow()
    'make new row
    ActiveCell.EntireRow.Insert Shift:=xlDown
    'copy the row above
    ActiveCell.Offset(-1, 0).EntireRow.Copy Cells(ActiveCell.Row, 1)
    On Error Resume Next
    'clear every cell in the new line that does not have a formula
    ActiveCell.EntireRow.SpecialCells(xlCellTypeConstants, 23).ClearContents
End Sub

---

Cheers

Dave

Brettdj -> you're right...actually I had done that, but somehow it slipped :-)
I have used something like this before as a standard rightclick menu for me..

Code:

---

Selection.SpecialCells(xlCellTypeConstants, 23).Select
If Selection.Count > 0 Then Selection.ClearContents

---