0

I have a Worksheet_Change module in a worksheet, which allows me to select multiple, comma separated, non-repeatable numbers from a dropdown list, displayed in a single cell, e.g $C$4 will read "00004, 00006, 00009" etc. This is the code (which I copied verbatim from https://trumpexcel.com/select-multiple-items-drop-down-list-excel/#VBA-Code-to-allow-Multiple-Selections-in-a-Drop-down-List-without-repetition - I only changed the "Target" cell):

Private Sub Worksheet_Change(ByVal Target As Range)   
'Code by Sumit Bansal from https://trumpexcel.com   
'To allow multiple selections in a Drop Down List in Excel (without repetition)   
Dim Oldvalue As String  
Dim Newvalue As String  
Application.EnableEvents = False  
On Error GoTo Exitsub  
If Target.Address = "$K$9" 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  
                End If  
            Else:  
                Target.Value = Oldvalue  
            End If  
        End If  
    End If  
End If  
Application.EnableEvents = True  
Exitsub:   
Application.EnableEvents = True  
End Sub  

The problem - which I know I am not the first to have, and I've looked at several other solutions but none of them seem to work - is that I need the sheet to be protected. But when I protect it, the code no longer works, and I can only select one nr per cell.

I've tried turning off the EnableEvents and then adding the "unprotect" and "protect" lines in various places, but it makes 0 difference, it's as if the code completely ignores those lines, no matter where I put them. But the sheet HAS to be protected. There will be several people working with it, and there are very long and complicated formulas in other cells that I cannot afford them messing with. Any suggestions?

Damian
  • 5,152
  • 1
  • 10
  • 21
Ursula
  • 3
  • 3
  • 1
    `Me.Unprotect pass` after `Application.EnableEvents = False` and `Me.Protect pass` after the `Exitsub:` should work. P.S: your `Application.EnableEvents = True ` before the `Exitsub:` is unnecessary because even when there are no errors, the code will go to the one after `Exitsub:` – Damian Jun 28 '22 at 11:44
  • Thanks Damian, gave it a go - still nothing. The sheet is still unprotected. I'm confused that this should be this hard :/ – Ursula Jun 28 '22 at 12:06
  • Ursula, try to debug. Put a stop on the code and trigger the event. To put a stop click `Application.EnableEvents = False ` here in your code and press F9 or click in that point on the grey vertical area. After the event is triggered the code will be highlighted in yellow. To go line by line you can press F8 an see what the code is doing. – Damian Jun 28 '22 at 13:15
  • 1
    With `On Error GoTo Exitsub`, if there's an error after `Me.Unprotect pass` and before `Me.Protect pass` then your sub will exit before re-protecting the sheet. – Tim Williams Jun 28 '22 at 15:41
  • That first `Application.EnableEvents = False` shouldn't be there. – Tim Williams Jun 28 '22 at 15:46
  • The debugging doesn't happen. I saw that somewhere else and tried it, no go. I just assumed that's how Worksheet_Change code works? That you can't F8 it? The code runs, because my cell populates with the list correctly, but the stop doesn't happen, no matter where I put it, so nothing is highlighted in yellow. I've even put a stop on EVERY line, still nothing. – Ursula Jun 29 '22 at 08:51

1 Answers1

1

EDIT: added "remove item on re-selection"

This will work on a protected sheet, since it doesn't use SpecialCells:

Private Sub Worksheet_Change(ByVal Target As Range)
    Const SEP As String = ", "
    Dim Oldvalue As String, Newvalue As String, arr, m, v
    
    'avoid nested If's by first figuring out if we need to do anything...
    If Target.CountLarge > 1 Then Exit Sub           'single cell only
    If Target.Address <> "$K$9" Then Exit Sub        'only checking K9
    If Not HasListValidation(Target) Then Exit Sub   '...with a list validation
    If Target.Value = "" Then Exit Sub               '...and a value
    
    On Error GoTo Exitsub

    Application.EnableEvents = False
    Newvalue = Target.Value
    If Len(Newvalue) = 0 Then Exit Sub 'user has cleared the cell...
    
    Application.Undo
    Oldvalue = Target.Value
    
    Debug.Print Oldvalue, Newvalue
    
    If Oldvalue <> "" Then
        arr = Split(Oldvalue, SEP)
        m = Application.Match(Newvalue, arr, 0)
        If IsError(m) Then
            Newvalue = Oldvalue & SEP & Newvalue
        Else
            arr(m - 1) = ""
            Newvalue = ""
            For Each v In arr
                If Len(v) > 0 Then Newvalue = _
                    Newvalue & IIf(Len(Newvalue) > 0, SEP, "") & v
            Next v
        End If
    End If
    Target.Value = Newvalue
Exitsub:
    If Err.Number <> 0 Then Debug.Print "Error", Err.Description
    Application.EnableEvents = True
End Sub

'does a cell have a list validation?
Function HasListValidation(c As Range)
    Dim vType
    On Error Resume Next
    vType = c.Validation.Type
    On Error GoTo 0
    HasListValidation = (vType = 3)
End Function
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • ...and previously - https://stackoverflow.com/questions/55070577/vba-code-for-selecting-multiple-drop-down-options-not-working-on-protected-sheet/55070851#55070851 – Tim Williams Jun 28 '22 at 16:16
  • ...and a version which removes an item from the list if it's re-selected. https://stackoverflow.com/a/35044090/478884 – Tim Williams Jun 28 '22 at 16:18
  • Tim - am I doing something wrong? :( It still doesn't work when the sheet is protected. Is it a setting on my pc, perhaps? I removed the original code I placed above entirely and inserted yours. It still only works when the sheet is unprotected. – Ursula Jun 29 '22 at 10:10
  • Turns out I was doing something wrong - I had the code in a module, as opposed to inside the sheet itself *facepalm*. NOW it's working perfectly when the cell is protected! Thank you all for your amazing help :) – Ursula Jun 29 '22 at 10:33
  • Good to hear you got it working. – Tim Williams Jun 29 '22 at 15:41
  • I've been asked by the colleagues using this, how to remove the last nr selected from this list, if a mistake is made? Currently it is possible for the requirement to stretch to a list double-digits long (ie any nr above 10 items in the list), and if a mistake is made at any point, the only way to fix it is to clear the cell and start the entire list from scratch, which could obviously be a pain when you're 37 items deep. Is it possible to just remove the incorrect nr (which should be the last one selected, which the user mistakenly clicked on)? – Ursula Jul 13 '22 at 07:35
  • The link I posted above is to a version which removes any item which is re-selected from the drop-down: https://stackoverflow.com/a/35044090/478884 You're not restricted to removing only the last-added item. – Tim Williams Jul 13 '22 at 15:15
  • The item they would want to remove isn't a re-selection, as the original code already doesn't allow you to re-select an item. If you click on an item twice it simply ignores you the second time. So the item they want to remove will be unique, but wrong, eg they clicked on 0005 instead of 0006, and now they want to remove 0005 in order to select 0006. If the code in your link works for this purpose as well, how do I combine it with the original code so it does both? – Ursula Jul 15 '22 at 06:14