Excel: Multidrop selections
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OldValue As String
Dim NewValue As String
Dim TempValue As String
Dim SplitValue() As String
Dim val As Variant
Dim MultiDrop As Boolean
On Error GoTo ErrorHandler
If Target.Column = 5 Or Target.Column = 6 Or Target.Column = 10 Or Target.Column = 11 Or Target.Column = 19 Or Target.Column = 24 Or Target.Column = 29 Then
MultiDrop = True
Else
MultiDrop = False
End If
If MultiDrop And Selection.Count = 1 Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
Exit Sub
Else
If Target.Value = "" Then
Exit Sub
Else
Application.EnableEvents = False
NewValue = Trim(Target.Value)
Application.Undo
OldValue = Trim(Target.Value)
If OldValue = "" Then
Target.Value = NewValue
Else
If InStr(1, OldValue, NewValue) = 0 Then
Target.Value = OldValue & "; " & NewValue
Else
Application.ScreenUpdating = False
TempValue = Replace(OldValue, NewValue, "") 'remove name that was just clicked
'clean the string to remove leading, trailing and double commas
SplitValue() = Split(TempValue, ";")
NewValue = ""
For Each val In SplitValue
TempValue = Replace(Trim(val), ";", "")
If TempValue <> "" Then
If NewValue = "" Then
NewValue = TempValue
Else
NewValue = NewValue & "; " & TempValue
End If
End If
Next val
Application.ScreenUpdating = True
Target.Value = NewValue
End If
End If
Application.EnableEvents = True
End If
End If
End If
Exit Sub
ErrorHandler:
MsgBox "An error has occurred"
Exit Sub
End Sub