Excel VBA to run Macro in new row is Inserted

excelvba

I am trying to have my spreadsheet automatically take the previous rows format and formulas when a new row is inserted.

I read where you can set up your sheet to automatically run the code if a change is made, but I am having a hard time getting the code to work.

I have tried the following and every time I insert a new row it keeps adding a row until it gets an error and I have to force quit:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Range("A1:D25") = ActiveCell.EntireRow.Insert Then
        Cells(1, 2).Value = 10
    End If 
End Sub

I added the Cell Value = 10 to see if it would work. It was just a test, but it still fails.

Does anyone know a possible solution?

Best Solution

There are two main issues in your code

  1. You are causing an Event Cascade. Ie your Change event is triggering further change events
  2. .Insert doesn't do what you seem to think it does. It doesn't detect inserted rows, it Inserts rows.

I am assuming by "... insert a new row ..." you mean Insert a whole row

This demo avoids the cascade with .EnableEvents = False and uses Copy, pasteSpecial to copy formats and formulas.

Option Explicit

Dim RowsCount As Long ' Variable to track number of rows used in sheet

Private Sub Worksheet_Activate()
    RowsCount = Me.UsedRange.Rows.Count
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo EH
    ' Detect whole row changed
    If Target.Columns.Count = Me.Columns.Count Then
        ' Detect Extra Row
        If RowsCount = Me.UsedRange.Rows.Count - 1 Then
            ' Copy Formulas and Format new row
            Application.EnableEvents = False
            If Target.Row > 1 Then
                Target.Offset(-1, 0).Copy
                Target.PasteSpecial xlPasteFormulas, xlPasteSpecialOperationNone, False, False
                Target.PasteSpecial xlPasteFormats, xlPasteSpecialOperationNone, False, False
                Application.CutCopyMode = False
            End If
        End If
        RowsCount = Me.UsedRange.Rows.Count
    End If

EH:
    Application.EnableEvents = True
End Sub
Related Question