VBA - Select Multiple Items from a Drop Down - vba

Question

I utilized the code by Sumit Bansal at trumpexcel.com, however, the code doesn't seem to work. It is supposed to select more than one of the texts from the drop down without repetition. The drop down is for cells C8, C22, C36, until C134. Here is the code, thanks in advance.
Option Explicit
Private Sub DropDown(ByVal Target As Range)
'Code by Sumit Bansal from https://trumpexcel.com
' To Select Multiple Items from a Drop Down List in Excel
Dim Oldvalue As String
Dim Newvalue As String
Dim x As Double
Application.EnableEvents = True
On Error GoTo Exitsub
For x = 1 To 10
If Target.Address = Worksheets("BSOAP").Range("C" & (14 * x - 6)) 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
Next x
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Answer 1

All you need to do is leave the code exactly as it was given and place it in your worksheet, with the following modifications:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal from https://trumpexcel.com
'Modified by TheEngineer from https://stackoverflow.com/
' To Select Multiple Items from a Drop Down List in Excel
Dim Oldvalue As String
Dim Newvalue As String
Dim i As Long
Dim b As Boolean
Dim arr(1 To 10) As String
For i = 1 To 10
arr(i) = "$C$" & (14 * i - 6)
Next i
On Error GoTo Exitsub
If Contains(arr, Target.Address) 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
Target.Value = Oldvalue & ", " & Newvalue
End If
End If
End If
Exitsub:
Application.EnableEvents = True
End Sub
Function Contains(arr, v) As Boolean
Dim rv As Boolean, lb As Long, ub As Long, i As Long
lb = LBound(arr)
ub = UBound(arr)
For i = lb To ub
If arr(i) = v Then
rv = True
Exit For
End If
Next i
Contains = rv
End Function
The Function was found here: Matching values in string array
This will allow you to select multiple items from the dropdown lists in the ten cells you referenced.
It is worth noting that this code uses the Undo function, so any time you use it to select multiple items, you will lose your ability to Undo anything before that point.