Multiple selections from drop down list

[mykal66]

Hi

I have some code from that allows users to select multiple options from a drop down list in a specific column, in the code below it is columns 4. Does anyone know how to amend this so it applied to columns 4 & 5 please?


Private Sub Worksheet_Change(ByVal Target As Range)Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strVal As String
Dim i As Long
Dim lCount As Long
Dim lMax As Long
Dim Ar As Variant
On Error Resume Next
Dim lType As Long
If Target.Count > 1 Then GoTo exitHandler


lType = Target.Validation.Type
lMax = 5


If lType = 3 Then
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 4 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
On Error Resume Next
Ar = Split(oldVal, ", ")
strVal = ""

For i = LBound(Ar) To UBound(Ar)
If newVal = CStr(Ar(i)) Then
'do not include this item
strVal = strVal
lCount = 1
Else
strVal = strVal & CStr(Ar(i)) & ", "
End If
Next i

If lCount > 0 Then 'newVal not included
Target.Value = Left(strVal, Len(strVal) - 2)
Else
'if cell contains item limit
' show message and restore old value
If i >= lMax Then
Target.Value = oldVal
MsgBox "Too many items -- limit is " & lMax
Else
Target.Value = strVal & newVal
End If
End If
End If
End If
End If
End If


exitHandler:
Application.EnableEvents = True
End Sub

[ppawan]

posted in error

[baxius]

Not sure if this will help. But excel itself has a really neat Drop-down list option in Data Validation Tab.

[snb]

Did you read/analyse/understand the code you posted ?

[mykal66]

Hi. I did work out most of the code and changed it to a different column and increase the max number of items etc

[ppawan]

Hi Please share a solution with us as well, and how does it work, if you could attach the excel sample file it will be amazing.

[mykal66]

Found some different code that works. Set up drop down lists in normal way then add this code

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 7 Or Target.Column = 8 Or Target.Column = 9 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
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub