I have developed on my excel spreadsheet that multiple items can be selected in a drop down list using the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If oldVal = "" Then
Else
If newVal = "" Then
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
But, I want to now validate the answers that the drop down list items can only be selected once. And preferably, if the user selects that item again, that is it then removed.
Any help would be greatly appreciated.
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Const SEP As String = ", "
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim arr, m, v
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Target.SpecialCells(xlCellTypeSameValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then Exit Sub
newVal = Target.Value
If Len(newVal) = 0 Then Exit Sub 'user has cleared the cell...
Application.EnableEvents = False
Application.Undo
oldVal = Target.Value
If oldVal <> "" Then
arr = Split(oldVal, SEP)
m = Application.Match(newVal, arr, 0)
If IsError(m) Then
newVal = oldVal & SEP & newVal
Else
arr(m - 1) = ""
newVal = ""
For Each v In arr
If Len(v) > 0 Then newVal = newVal & IIf(Len(newVal) > 0, SEP, "") & v
Next v
End If
Target.Value = newVal
Else
Target.Value = newVal 'EDIT
End If
exitHandler:
Application.EnableEvents = True
End Sub