How to delete a value in a cell from a list-CodePudding

I am trying to figure out how to delete a value coming from a list in a cell.

What i have is a list where you can select multiple values. The problem with this is that i needed to open the list for each choice.

And the second problem is that if i want to delete one value, i have to delete them all and then choose again.

If someone has any ideas on how to do to improve what i have i will appreciate.

For reference : this is the VBA code that i add in my previous excel sheet :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 5 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

CodePudding user response：

Please, test the next updated code. It checks if the new selected string already exists in the list and if so, asks for exclusion. Pressing Yes, it will be excluded:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String, Newvalue As String, ans As VbMsgBoxResult

If Target.cells.count > 1 Then Exit Sub 'if more than one cell changed (by copying, for example) code exists
If Not hasLValidation(Target) Then Exit Sub 'if no List validtion code exits
If Target.Value = "" Then Exit Sub

On Error GoTo Exitsub
If Target.Column = 5 Then
    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
                  ans = MsgBox("Do you like excluding """ & Newvalue & """ from the list?" & vbCrLf & _
                               "For excluding, please press ""Yes""!", vbYesNo, "Exclusion confirmation")
                      If ans <> vbYes Then
                            Target.Value = Oldvalue
                      Else
                            Dim arr, mtch
                            arr = Split(Oldvalue, ", ")   'place the list in an array
                            mtch = Application.match(Newvalue, arr, 0) 'match the array element
                            If Not IsError(mtch) Then    'if a match exists:
                                arr(mtch - 1) = "@#$%&"  'replace that element with a strange string different from all existing
                                arr = filter(arr, "@#$%&", False) 'eliminate that specific element

                                Target.Value = Join(arr, ", ")       'place back the list by joining the array
                            End If
                      End If
             End If
    End If
End If

Exitsub:
Application.EnableEvents = True
End Sub

Function hasLValidation(T As Range) As Boolean
    Dim vType As Long
    On Error Resume Next
       vType = T.Validation.Type
    On Error GoTo 0
    If vType = 3 Then hasLValidation = True 'only for LIST validation type!
End Function

Please, send some feedback after testing it.