VBA Code for selecting multiple drop down options not working on protected sheet

Question

I'm using the following code to allow multiple selections for in cell drop downs but the code stops working if I protect the sheet. Rather than adding a subsequent clicks separated by a comma, it just replaces the original selection.

The Target cells are not locked, yet it still isn't working. Any ideas?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If ActiveSheet.Cells(3, Target.Column) = "MS" Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

"isn't working" is not a useful description of what happens when your code runs. Where and how does it fail? Note you may need to comment out the error handler to debug your problem. — Tim Williams, Mar 08 '19 at 20:31
Apologies. It works as regular cell validation and just replaces the original choice rather than adding a second one. — klive17, Mar 08 '19 at 20:33
If you comment out `On Error GoTo Exitsub` you will see the problem - you ca't use `SpecialCells(xlCellTypeAllValidation)` on a protected sheet — Tim Williams, Mar 08 '19 at 20:45

score 0 · Accepted Answer · answered Mar 08 '19 at 20:54

This will work on a protected sheet:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Oldvalue As String, Newvalue As String

    If Target.CountLarge > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Me.Cells(3, Target.Column) <> "MS" Then Exit Sub

    On Error GoTo Exitsub
    If HasValidation(Target) Then

        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        If Oldvalue = "" Then
            Target.Value = Newvalue
        ElseIf InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
        Else
            Target.Value = Oldvalue
        End If
        Application.EnableEvents = True

    End If

Exitsub:
    Application.EnableEvents = True
End Sub

Function HasValidation(cell As Range) As Boolean
    Dim t: t = Null

    On Error Resume Next
    t = cell.Validation.Type
    On Error GoTo 0

    HasValidation = Not IsNull(t)
End Function

Function is from AgentRev's answer here: Determine if cell contains data validation

VBA Code for selecting multiple drop down options not working on protected sheet

1 Answers1

Linked