worksheet change event not triggering?

user_12080212 0
Viewed 349

I have code in a worksheet object in order to trigger format & formula pasting to the next lr.

Private Sub Worksheet_Change(ByVal target As Range)
    Dim lr As Long
    lr = Cells(Rows.Count, "A").End(xlUp).row
    If Intersect(target, Range("D1:D" & lr)) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Rows(lr).Copy
    Rows(lr).EntireRow.PasteSpecial Paste:=xlPasteFormats
    Rows(lr).EntireRow.PasteSpecial Paste:=xlPasteFormulas
    Application.EnableEvents = True
    Application.CutCopyMode = False
End Sub

Since this is triggered when data for the next new row is appended, shouldn't this trigger on it's own?

vba excel
1 Answers

A Worksheet Change: SpecialCells feat. FillDown

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const Cols As String = "A:BC"
    
    Dim lCell As Range
    Set lCell = Columns(Cols).Find("*", , xlFormulas, , xlByRows, xlPrevious)
    
    If lCell Is Nothing Then Exit Sub
    If Intersect(Columns(Cols).Rows(lCell.Row), Target) Is Nothing Then Exit Sub
    
    On Error GoTo clearError
    
    Dim rrg As Range: Set rrg = Rows(lCell.Row - 1)
    Application.EnableEvents = False
    
    Dim frg As Range: Set frg = rrg.SpecialCells(xlCellTypeFormulas)
    Intersect(rrg.Resize(2), frg.EntireColumn).FillDown
    
    rrg.Copy
    rrg.Offset(1).PasteSpecial xlPasteFormats
    
    rrg.Cells(1).Offset(1).Select

SafeExit:
    If Application.CutCopyMode Then
        Application.CutCopyMode = False
    End If
    If Not Application.EnableEvents Then
        Application.EnableEvents = True
    End If
    
    Exit Sub

clearError:
    Debug.Print "Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    Resume SafeExit

End Sub
user_98140690
Related