Application-defined or object-defined error when any cell in worksheet is edited

Question

I am relatively new to VBA and have managed to edit a worksheet_change sub from example code found online (Thanks Tim Williams!) that allows multiple selection and deselection in drop down-lists within specified rows and at the same time clears dependent cell contents when parent drop-down lists are edited.

I did have another version that worked a treat and included multiple separators ",", "and" and "to" to construct short sentences/lists but didn't allow deselection. I've been struggling to combine an example code that includes deselection with other code that clears data in a single Private Sub. I have found many different methods but using some code posted by Tim Williams on another thread is the closest I've got to finding something that works. But I get an "Application-defined or object-defined error" pop-up in excel each time I try to edit a cell and I'm not sure why.

The worksheet that it is associated with will be copied 10's or possibly even 100's of times in the same workbook and the workbooks themselves will be copied hence there are no worksheet or workbook references.

I would be very grateful if someone could spot my error(s) and suggest how to fix them. Thanks. Here is the code.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const SEP As String = ", "
    Dim c As Range, Newvalue As String, Oldvalue As String, arr, v, lst, removed As Boolean
    Application.EnableEvents = True
    On Error GoTo Exitsub
    

    If Target.Row = 14 And Target.Validation.Type = 3 Then
        Target.Offset(1, 0).ClearContents
        Target.Offset(2, 0).ClearContents
    End If
        If Target.Row = 20 And Target.Validation.Type = 3 Then
        Target.Offset(2, 0).ClearContents
    End If

    If Target.Row = 15 Or 16 Or 17 Or 21 Or 22 Or 28 Or 29 Or 31 Or 33 Then
    
    If Target.CountLarge > 1 Then Exit Sub '<< only handling single-cell changes

    Select Case Target.Row
        Case 15, 16, 17, 21, 22, 28, 29, 31, 33
            Set c = Target
        Case Else: Exit Sub
        End Select
    
    If Len(c.Value) > 0 And Not c.Validation Is Nothing Then

        Application.EnableEvents = False
        Newvalue = c.Value
        Application.Undo
        Oldvalue = c.Value

        If Oldvalue = "" Then
            c.Value = Newvalue
        Else
            arr = Split(Oldvalue, SEP)
            'loop over previous list, removing newvalue if found
            For Each v In arr
                If Trim(CStr(v)) = Newvalue Then
                    removed = True
                Else
                    lst = lst & IIf(lst = "", "", SEP) & v
                End If
            Next v
            'add the new value if we didn't just remove it
            If Not removed Then lst = lst & IIf(lst = "", "", SEP) & Newvalue
            c.Value = lst
        End If
    End If
    End If    'has validation and non-empty
    Exitsub:
    If Err.Number <> 0 Then MsgBox Err.Description
    Application.EnableEvents = True
End Sub

Answer 1

Lightly tested:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const SEP As String = ", "
    Dim c As Range, Newvalue As String, Oldvalue As String, arr, v, lst, removed As Boolean
    
    'Application.EnableEvents = True 'this only runs if EnableEvents is *already* True...
    On Error GoTo Exitsub
    
    If Target.CountLarge > 1 Then Exit Sub '<< only handling single-cell changes
    
    Set c = Target
    If Not HasListValidation(c) Then Exit Sub 'exit if cell has no list validation
    
    'you can handle all the row checking here...
    Select Case c.Row
        Case 14
            c.Offset(1, 0).Resize(2, 1).ClearContents
            Exit Sub  'added
        Case 20
            c.Offset(2, 0).ClearContents
            Exit Sub  'added
        Case 15, 16, 17, 21, 22, 28, 29, 31, 33 'ok to proceed
        Case Else: Exit Sub
    End Select
    
    If Len(c.Value) > 0 Then

        Application.EnableEvents = False
        Newvalue = c.Value
        Application.Undo
        Oldvalue = c.Value

        If Oldvalue = "" Then
            c.Value = Newvalue
        Else
            arr = Split(Oldvalue, SEP)
            'loop over previous list, removing newvalue if found
            For Each v In arr
                If Trim(CStr(v)) = Newvalue Then
                    removed = True
                Else
                    lst = lst & IIf(lst = "", "", SEP) & v
                End If
            Next v
            'add the new value if we didn't just remove it
            If Not removed Then lst = lst & IIf(lst = "", "", SEP) & Newvalue
            c.Value = lst
        End If
    End If  'c not empty
    
Exitsub:
    If Err.Number <> 0 Then MsgBox Err.Description
    Application.EnableEvents = True
End Sub

'does a cell have a List validation applied?
Function HasListValidation(c As Range) As Boolean
    Dim v
    On Error Resume Next
    v = c.Validation.Type
    On Error GoTo 0
    HasListValidation = (v = xlValidateList) '3
End Function