Make Excel List to multiselect

With this VBA Code you can make a Data Validation list to an multiselect list

Private Sub Worksheet_Change(ByVal Target As Range)
    '** Multiselect via Dropdown List (Validation)
    '** Insert in the code container of the relevant worksheet
    Dim rngDV As Range
    Dim oldVal As String
    Dim newVal As String
    Dim makeMultiselect As Boolean
    Dim cellsToCheck As Range
    Dim arrValues As Variant
    Dim i As Integer
    Dim found As Boolean
    Dim result As String

    '** Error handling
    On Error GoTo Errorhandling

    '** Defining the range of cells that should allow multiselect
    Set cellsToCheck = Union(Range("E21"), Range("F20"), Range("F19"))

    '** Check if the changed cell is in the defined multiselect cells range
    If Not Application.Intersect(Target, cellsToCheck) Is Nothing Then
        makeMultiselect = True
    End If

    '** Perform multiselect in the defined range
    If makeMultiselect Then
        '** Define the range
        Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
        If rngDV Is Nothing Then GoTo Errorhandling
        '** Check if a valid cell was selected and insert values
        If Not Application.Intersect(Target, rngDV) Is Nothing Then
            Application.EnableEvents = False
            newVal = Target.Value
            Application.Undo
            oldVal = Target.Value
            Target.Value = newVal
            '** Toggle logic for selecting/deselecting values
            If newVal = "" Then  ' Clearing the cell completely if Del is pressed
                Target.Value = ""
            ElseIf oldVal <> "" Then
                arrValues = Split(oldVal, ", ")
                found = False
                result = ""
                For i = LBound(arrValues) To UBound(arrValues)
                    If arrValues(i) = newVal And Not found Then
                        found = True
                    Else
                        If result = "" Then
                            result = arrValues(i)
                        Else
                            result = result & ", " & arrValues(i)
                        End If
                    End If
                Next i
                If Not found Then
                    If result = "" Then
                        result = newVal
                    Else
                        result = result & ", " & newVal
                    End If
                End If
                Target.Value = result
            End If
        End If
        Application.EnableEvents = True
    End If

Errorhandling:
    Application.EnableEvents = True
End Sub