By the kind help of Dear @Taller, below code adds checkmarks to debut of each option in a multi-select dropdown list created with data validation. However, I got a feedback/criticize from my manager regarding the situation that a 'NONE' option should have been added in the list. When 'NONE' is selected the remaining options cannot be and when the other options are selected the 'NONE' cannot be selected at the same time. Is it possible to solve this problem by VBA coding? Thank you very much in advance.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("F4:F29")) Is Nothing 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
If AscW(Left(Oldvalue, 1)) <> &H2713 Then
Oldvalue = ChrW(&H2713) & Space(1) & Oldvalue
End If
Target.Value = Oldvalue & vbNewLine & ChrW(&H2713) & Space(1) & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
Your question is not so clear in terms of what is to be done when 'NONE' is selected. I asked a clarification question but you did not answer it. The next code clears the validation list if you select 'NONE' in an empty such list validated cell and keeps only the previous selected items in the validation list when you select 'NONE':
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String, Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("F4:F29")) Is Nothing 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
If Newvalue = "NONE" Then
Target.Validation.Delete 'delete the cell validation if nothing existed in cell
End If
Else
If Newvalue = "NONE" Then
'extract the existing validating list:
Dim exList: exList = Split(Target.value, vbNewLine)
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:=Join(exList, ",") 'keep only existing Target values
End With
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
If AscW(left(Oldvalue, 1)) <> &H2713 Then
Oldvalue = ChrW(&H2713) & space(1) & Oldvalue
End If
Target.value = Oldvalue & vbNewLine & ChrW(&H2713) & space(1) & Newvalue
Else:
Target.value = Oldvalue
End If
End If
End If
End If
End If
Exitsub:
Application.EnableEvents = True
End Sub
The above code treats the validation list obtained by inputting a comma separated string in Source
...
If you validate in a different way, it is time to explain how you do it.
Edited:
Please, use the next version. It should do what (I understood) you need:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String, Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("F4:F29")) Is Nothing 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
ElseIf Oldvalue = "NONE" Then
'DO NOTHING...
Else
If Newvalue = "NONE" Then GoTo Exitsub
If InStr(1, Oldvalue, Newvalue) = 0 Then
If AscW(left(Oldvalue, 1)) <> &H2713 Then
Oldvalue = ChrW(&H2713) & space(1) & Oldvalue
End If
Target.value = Oldvalue & vbNewLine & ChrW(&H2713) & space(1) & Newvalue
Else:
Target.value = Oldvalue
End If
End If
End If
End If
Exitsub:
Application.EnableEvents = True
End Sub