VBA multiple selections from a drop-down in protected sheet

[kcmuppet]

Hi - this nice VBA allows multiple selections from a drop-down.

I was hoping I could get it work on a protected sheet by adding: ActiveSheet.Unprotect before Application.EnableEvents = False and ActiveSheet.Protect
after Application.EnableEvents = True...but that didn't work: The sheet remained protected the next time I tried to to select from the drop-down in another cell in DV_Range.

How can it be modified to work in protected sheet?

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

'Originally from Phil Treacy see https://www.myonlinetraininghub.com/select-multiple-items-from-drop-down-data-validation-list

    Dim OldVal As String
    Dim NewVal As String
    ' If more than 1 cell is being changed
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Not Intersect(Target, ActiveSheet.Range("DV_Range")) Is Nothing Then
        ' Turn off events so our changes don't trigger this event again
        ActiveSheet.Unprotect
        Application.EnableEvents = False
        NewVal = Target.Value
        ' If there's nothing to undo this will cause an error
        On Error Resume Next
        Application.Undo
        On Error GoTo 0
        OldVal = Target.Value
        ' If selection is already in the cell we want to remove it
        If InStr(OldVal, NewVal) Then
            'If there's a comma in the cell, there's more than one word in the cell
            If InStr(OldVal, ",") Then
                If InStr(OldVal, ", " & NewVal) Then
                    Target.Value = Replace(OldVal, ", " & NewVal, "")
                Else
                    Target.Value = Replace(OldVal, NewVal & ", ", "")
                End If
            Else
                ' If we get to here the selection was the only thing in the cell
                Target.Value = ""
            End If
        Else
            If OldVal = "" Then
                Target.Value = NewVal
            Else
                ' Delete cell contents
                If NewVal = "" Then
                    Target.Value = ""
                Else
                    ' This IF prevents the same value appearing in the cell multiple times
                    ' If you are happy to have the same value multiple times remove this IF
                    If InStr(Target.Value, NewVal) = 0 Then
                        Target.Value = OldVal & ", " & NewVal
                    End If
                End If
            End If
        End If
        
        Application.EnableEvents = True
    Else
        Exit Sub
         ActiveSheet.Protect
    End If
End Sub

 

[kcmuppet]

I looked around for another approach and can see that Debra Dalgliesh created a version that works with a protected sheet.

Sadly, this example doesn't incorporate the ability to remove previously selected items.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' Developed by Contextures Inc.
' www.contextures.com
'code runs on protected sheet
Dim oldVal As String
Dim newVal As String
Dim strSep As String
Dim strType As Long


'add comma and space between items
strSep = ", "


If Target.Count > 1 Then GoTo exitHandler


'checks validation type of target cell
'type 3 is a drop down list
On Error Resume Next
strType = Target.Validation.Type


If Target.Column = 3 And strType = 3 Then
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  If oldVal = "" Or newVal = "" Then
    Target.Value = newVal
  Else
    Target.Value = oldVal _
      & strSep & newVal
  End If
End If

I spent a few hours getting nowhere trying to add the Target.Validation.Type 3 into Phil Treacy's code in the original post, but couldn't get it to work. Would appreciate somebody's help, as this doesn't work in a protected sheet:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

'Originally from Phil Treacy see https://www.myonlinetraininghub.com/select-multiple-items-from-drop-down-data-validation-list

    Dim OldVal As String
    Dim NewVal As String
    Dim ValType As Long
   
    ' If more than 1 cell is being changed
        If Target.Count > 1 Then Exit Sub
   
On Error Resume Next
ValType = Target.Validation.Type   'ValType = 3 if data val list

On Error Resume Next
If ValType <> 3 Then Exit Sub

    If Target.Value = "" Then Exit Sub
    If Not Intersect(Target, ActiveSheet.Range("DV_Range")) Is Nothing Then
        ' Turn off events so our changes don't trigger this event again
        Application.EnableEvents = False
             
        NewVal = Target.Value
        ' If there's nothing to undo this will cause an error
        On Error Resume Next
        Application.Undo
        On Error GoTo 0
        OldVal = Target.Value
        ' If selection is already in the cell we want to remove it
        If InStr(OldVal, NewVal) Then
            'If there's a comma in the cell, there's more than one word in the cell
            If InStr(OldVal, ",") Then
                If InStr(OldVal, ", " & NewVal) Then
                    Target.Value = Replace(OldVal, ", " & NewVal, "")
                Else
                    Target.Value = Replace(OldVal, NewVal & ", ", "")
                End If
            Else
                ' If we get to here the selection was the only thing in the cell
                Target.Value = ""
            End If
        Else
            If OldVal = "" Then
                Target.Value = NewVal
            Else
                ' Delete cell contents
                If NewVal = "" Then
                    Target.Value = ""
                Else
                    ' This IF prevents the same value appearing in the cell multiple times
                    ' If you are happy to have the same value multiple times remove this IF
                    If InStr(Target.Value, NewVal) = 0 Then
                        Target.Value = OldVal & ", " & NewVal
                    End If
                End If
            End If
        End If
       
        Application.EnableEvents = True
    Else
        Exit Sub

    End If
End Sub

 

[kcmuppet]

Eventually I went with the following to make sure the sheet is unprotected when the DV_Range range is selected but return the sheet to it’s protection status when the DV_Range range is not selected

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
‘ Check if the target range intersects with the defined range
If Not Intersect(Target, ActiveSheet.Range(“DV_Range”)) Is Nothing Then
‘ If it does, unprotect the sheet if it’s protected
Dim isProtected As Boolean
isProtected = Me.ProtectContents
If isProtected Then
Me.Unprotect
End If
Else
‘ If it doesn’t, restore the original protection status
If isProtected Then
Me.Protect
End If
End If
End Sub