Running two worksheet_change events on the same worksheet

Question

I am trying to run two worksheet_change event codes on the same worksheet. One to move completed rows to another worksheet and the other one to send emails based on value in another cell. The email code works.

The completed row move raises

Run-Time error '424' Object required.

When I debug it highlights the If Target.Cells.Count > 1 Then line in Worksheet_change2. Both codes run individually fine.

Private Sub Worksheet_Change(ByVal Target As Range)
    Worksheet_Change1 Target
    Worksheet_Change2 Target
End Sub

Sub Worksheet_Change1(ByVal Target As Range)
    Dim xRg As Range
    Dim xCell As Range
    Dim A As Long
    Dim B As Long
    Dim C As Long
    A = Worksheets("Working").UsedRange.Rows.Count
    B = Worksheets("Completed").UsedRange.Rows.Count
    If B = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Completed").UsedRange) = 0 Then B = 0
    End If
    Set xRg = Worksheets("Working").Range("I1:I" & A)
    On Error Resume Next
    Application.ScreenUpdating = False
    For C = 1 To xRg.Count
        If CStr(xRg(C).Value) = "Done" Then
            xRg(C).EntireRow.Copy Destination:=Worksheets("Completed").Range("A" & B + 1)
            xRg(C).EntireRow.Delete
            If CStr(xRg(C).Value) = "Done" Then
                C = C - 1
            End If
            B = B + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Sub Worksheet_Change2(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If (Not Intersect(Target, Range("G:G")) Is Nothing) And (Target.Value = "MOBILARIS") Then
        Call Mail_small_Text_Outlook1
    End If
    If (Not Intersect(Target, Range("G:G")) Is Nothing) And (Target.Value = "COMMS TECH") Then
        Call Mail_small_Text_Outlook2
    End If 
    If (Not Intersect(Target, Range("G:G")) Is Nothing) And (Target.Value = "PLANNING ENGINEER") Then
        Call Mail_small_Text_Outlook3
        If Target.Cells.Count > 1 Then Exit Sub
    End If
End Sub

Sub Mail_small_Text_Outlook1()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi" & vbNewLine & vbNewLine & _
    "Please check the Comms Issue Register, there has been an issue reported regarding Mobilaris" & vbNewLine & _
    "Thankyou"
    On Error Resume Next
    With xOutMail
        .To = "xxxx"
        .CC = ""
        .BCC = ""
        .Subject = "Mobilaris Issue"
        .Body = xMailBody
        .Send 'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Sub Mail_small_Text_Outlook2()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi" & vbNewLine & vbNewLine & _
    "Please check the Comms Issue Register, there has been an issue reported with comms somewhere UG" &      vbNewLine & _
    "Thankyou"
    On Error Resume Next
    With xOutMail
        .To = "xxxx"
        .CC = ""
        .BCC = ""
        .Subject = "Communications Issue"
        .Body = xMailBody
        .Send 'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Sub Mail_small_Text_Outlook3()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi" & vbNewLine & vbNewLine & _
    "Please check the Comms Issue Register, there is Leaky Feeder extensions that are needed to be       scheduled" & vbNewLine & _
    "Thankyou"
    On Error Resume Next
    With xOutMail
        .To = "xxxxx"
        .CC = ""
        .BCC = ""
        .Subject = "Leaky Feeder extensions required"
        .Body = xMailBody
        .Send 'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Is this code from worksheet `Working`? If yes: You are modifying the working in `Worksheet_Change1` (by deleting rows). This triggers the event routine again (with a new target`). Set `Application.EnableEvents = False` while your event handler runs (but don't forget to enable it at the end). See https://stackoverflow.com/a/13861640/7599798 — FunThomas, May 16 '23 at 09:33
Hi GSerg, Where exacly do I need to Set Application.EnableEvents = False in my code? And yes this code is for worksheet Working — petenielsen77, May 16 '23 at 21:37
Have a look to the first pieve of code of the linked answer: put it at the beginning of your event routine. Enable the events at the end of the event routine. Use `On Error Goto ...` to catch errors and ensure that the enabling of events is always executed. — FunThomas, May 17 '23 at 12:09

score 0 · Answer 1 · answered May 16 '23 at 22:06

I think the problem is that if your code is triggered by entering a value of "Done" in column I, then you are copying the line to the "Completed" sheet, then deleting that line from the "Working" sheet.

I suspect, that when the second sub, Change2 is triggered, the original line has been deleted and therefore the object which is passed to the second sub doesn't exist any more.

Two ways to test - 1) Change the order of the subs running on change or 2) comment out the line in the code which deletes the entry in the Working tab

Running two worksheet_change events on the same worksheet

1 Answers1