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