Prevent EventChange Sub running unexpectedly

Question

Advice would be gratefully appreciated. I am developing a spreadsheet using Excel 2016/Windows.

I have written 4 eventchange subroutines and all work well. The VBA Code for a worksheet checks for 4 events. Event 1, 2 and 3 enter today's date in a cell if data is entered in another cell (code not included below)

Code for EventChange works fine, but sometimes works when not expected to!

EventChange4 moves a value from one cell to another if another cell contains the text in Column J is "THIS Month – Payment Due" or "Issued But Not Paid. The second part of this eventchange4 moves a zero value to 2 cells if the data in column j contains text "not going ahead"

I am new to VBA. The problem is that eventchange4 runs for no apparent reason, e.g. copying a cell value in column H down to another cell in column h. How can I modify the code such that that eventchange4 only runs when the data in Column J Changes??? All advice gratefully accepted!!!!

Private Sub Worksheet_Change(ByVal Target As Range)
Call EventChange_1(Target) 
Call EventChange_2(Target)
Call EventChange_3(Target)
Call EventChange_4(Target)
End Sub
Sub EventChange_1(ByVal Target As Range)
'Update on 11/11/2019 -If data changes in column L, insert
'today's date into column M

End Sub
Sub EventChange_2(ByVal Target As Range)
'Update  on 15/01/2020 -If data changes in column P, insert today's date
'into next Column Q

End Sub
Sub EventChange_3(ByVal Target As Range)
'Update on 15/01/2020 -If data changes in column R, insert today's date
'into next Column S

End Sub

Sub EventChange_4(ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False
' this works !

    If Target.Column = 10 And (Target.Value = "THIS Month – Payment Due" Or Target.Value = "Issued But Not Paid") Then
        Range("K" & Target.Row).Value = Range("I" & Target.Row).Value
        Range("I" & Target.Row).Clear
        MsgBox "Moved Commission Due to Month Paid"
    End If
    If Target.Column = 10 And (Target.Value = "Not Going Ahead") Then
        Range("I" & Target.Row).Value = 0
        Range("K" & Target.Row).Value = 0
        MsgBox "Moved ZERO to Initial Commisson and Month Paid"
    End If
    Application.EnableEvents = True
End Sub

Answer 1

Tim apologies. I am new to this and was anxious to get a solution. Thank you for your response. Advice Noted. T

When I attempt to insert or delete a row in the spreadsheet, the VBA code identifies a worksheet event and attempts to run the code. The spreadsheet crashes. I have attempted to add code that will prevent this by checking at the beginning of the module if a row has been inserted or deleted before the other worksheet change event if statements are checked

Thank you

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim aCell As Range
    Dim wsInc As Worksheet
    Dim count As Integer
    Dim lRow As Long
    Dim ans As Variant
    Dim tb As ListObject

    On Error GoTo Whoa

    Application.EnableEvents = False
    Set tb = ActiveSheet.ListObjects(1)
    MsgBox Target.Rows.count

    If tb.Range.Cells.count > count Then
      count = tb.Range.Cells.count
'      GoTo Whoa
    ElseIf tb.Range.Cells.count < count Then
      count = tb.Range.Cells.count
'      GoTo Whoa
   '~~> Check if the change happened in Col A
    ElseIf Not Intersect(Target, Columns(1)) Is Nothing Then
        For Each aCell In Target.Cells
            With aCell
                If Len(Trim(.Value)) = 0 Then
                    .Offset(, 1).ClearContents
                Else
                    .Offset(, 1).NumberFormat = "dd/mm/yyyy"
                    .Offset(, 1).Value = Now
                    With .Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                End If
            End With
        Next
    '~~> Check if the change happened in Col L
    ElseIf Not Intersect(Target, Columns(12)) Is Nothing Then
        Set wsInc = Sheets("Income")
        lRow = wsInc.Range("A" & wsInc.Rows.count).End(xlUp).Row + 1

        For Each aCell In Target.Cells
            With aCell
                If Len(Trim(.Value)) = 0 Then
                    .Offset(, 1).ClearContents
                Else
                    .Offset(, 1).NumberFormat = "dd/mm/yyyy"
                    .Offset(, 1).Value = Now
                    With .Interior
                        .Pattern = xlNone
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With

                    '~~> Check of the value is Fees Received, Policy No. Issued
                    If .Value = "Fees Received" Or .Value = "Policy No. Issued" Then
                        ans = MsgBox("Do you want to copy this client to the Income Worksheet?", vbQuestion + vbYesNo)

                        If ans = False Then Exit For

                        wsInc.Range("A" & lRow).Value = Range("A" & aCell.Row).Value
                    End If
                End If
            End With
        Next
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Answer 2

Ideally you should update your code so it can properly handle a Target range which is not just a single cell:

Sub EventChange_4(ByVal Target As Range)

    Dim rng As Range, c As Range, v

    'any part of Target in Column J?
    Set rng = Application.Intersect(Target, Me.Columns(10))

    If Not rng Is Nothing Then
        'have some cells to process...
        On Error GoTo haveError
        Application.EnableEvents = False
        'process each affected cell in Col J
        For Each c In rng.Cells
            v = c.Value
            If v = "THIS Month – Payment Due" Or v = "Issued But Not Paid" Then
                Range("K" & c.Row).Value = Range("I" & c.Row).Value
                Range("I" & c.Row).Clear
                MsgBox "Moved Commission Due to Month Paid"
            End If
            If v = "Not Going Ahead" Then
                Range("I" & c.Row).Value = 0
                Range("K" & c.Row).Value = 0
                MsgBox "Moved ZERO to Initial Commisson and Month Paid"
            End If
        Next c
    End If
haveError:
    Application.EnableEvents = True
End Sub

NOTE: this is assumed to be in the relevant worksheet code module - otherwise you should qualify the Range() calls with a specific worksheet reference.

All your "change" handlers should follow a similar pattern.