Combine 2 worksheet_change event macros

[AdarsH]

Hello Gurus!


I have 2 worksheet change event macros which both work fine separately but i want to include them on the same sheet. They are as follows:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim c As Range, i As Long
    On Error Resume Next
    Set c = Intersect(Target, Columns(1))
    If c Is Nothing Then Exit Sub
    If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
    i = c.Row
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Sheets("Formulas").Range("2:2").Copy
    Sheets("ICS").Range(i & ":" & i).PasteSpecial xlPasteFormulas, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    Sheets("ICS").Range(iX & ":" & i).PasteSpecial xlPasteValidation, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    Application.CutCopyMode = False
    c.Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub

and:

Private Sub Worksheet_Change(ByVal Target As Range)


Application.ScreenUpdating = False


Dim lngCols(1 To 14) As Long


lngCols(1) = 12
lngCols(2) = 67
lngCols(3) = 68
lngCols(4) = 69
lngCols(5) = 71
lngCols(6) = 72
lngCols(7) = 73
lngCols(8) = 75
lngCols(9) = 76
lngCols(10) = 78
lngCols(11) = 80
lngCols(12) = 81
lngCols(13) = 83
lngCols(14) = 83


    On Error GoTo ErrorHandler:
        If Target.Columns.Count <> Columns.Count Then Exit Sub
            
            For i = 1 To UBound(lngCols)
                Cells(Target.Offset(-1, 0).Row, lngCols(i)).Copy
                Cells(Target.Row, lngCols(i)).Select
                ActiveCell.PasteSpecial xlPasteFormulas
            Next i


ErrorHandler:
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

Any chance to do it?

 

[JLGWhiz]

See if this will work:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim c As Range, i As Long
    On Error Resume Next
    Set c = Intersect(Target, Columns(1))
    If c Is Nothing Then GoTo NEXPART:
    If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
    i = c.Row
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Sheets("Formulas").Range("2:2").Copy
    Sheets("ICS").Range(i & ":" & i).PasteSpecial xlPasteFormulas, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    Sheets("ICS").Range(iX & ":" & i).PasteSpecial xlPasteValidation, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    Application.CutCopyMode = False
    c.Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    On Error GoTo 0
NEXPART:
Application.ScreenUpdating = False
Dim lngCols(1 To 14) As Long
lngCols(1) = 12
lngCols(2) = 67
lngCols(3) = 68
lngCols(4) = 69
lngCols(5) = 71
lngCols(6) = 72
lngCols(7) = 73
lngCols(8) = 75
lngCols(9) = 76
lngCols(10) = 78
lngCols(11) = 80
lngCols(12) = 81
lngCols(13) = 83
lngCols(14) = 83
    On Error GoTo ErrorHandler:
        If Target.Columns.Count <> Columns.Count Then Exit Sub            
            For i = 1 To UBound(lngCols)
                Cells(Target.Offset(-1, 0).Row, lngCols(i)).Copy
                Cells(Target.Row, lngCols(i)).Select
                ActiveCell.PasteSpecial xlPasteFormulas
            Next i
ErrorHandler:
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

 

[AdarsH]

Hello JLGWhiz!

Using the solution provided, the first part works, but the second part does not; i.e, whenever i insert a new row using Right Click > Insert > Row, it does not copy the formula from above.

 

[RoryA]

Try this:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   Dim c                           As Range
   Dim i                           As Long
   Dim lngCols(1 To 14)            As Long
   
   On Error GoTo ErrorHandler
   
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
   End With
   
   Set c = Intersect(Target, Columns(1))
   
   If Not c Is Nothing Then
      If Not IsEmpty(c.Offset(-1, 0)) And IsEmpty(c.Offset(1, 0)) Then
         i = c.Row
         Sheets("Formulas").Range("2:2").Copy
         Sheets("ICS").Range(i & ":" & i).PasteSpecial xlPasteFormulas, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
         Sheets("ICS").Range(i & ":" & i).PasteSpecial xlPasteValidation, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
         Application.CutCopyMode = False
         c.Select
      End If
   End If
   
   If Target.Columns.Count = Columns.Count Then
      lngCols(1) = 12
      lngCols(2) = 67
      lngCols(3) = 68
      lngCols(4) = 69
      lngCols(5) = 71
      lngCols(6) = 72
      lngCols(7) = 73
      lngCols(8) = 75
      lngCols(9) = 76
      lngCols(10) = 78
      lngCols(11) = 80
      lngCols(12) = 81
      lngCols(13) = 83
      lngCols(14) = 83
      For i = 1 To UBound(lngCols)
         Cells(Target.Offset(-1, 0).Row, lngCols(i)).Copy
         Cells(Target.Row, lngCols(i)).PasteSpecial xlPasteFormulas
      Next i
   End If
ErrorHandler:
   With Application
      .CutCopyMode = False
      .EnableEvents = True
      .ScreenUpdating = True
   End With
End Sub