Drop-down list with multiple entries in a single cell

[Innoguide]

Is there anyway, I can create a drop down list that allows users to choose items from a list and place them into a single cell with comma separation (e.g. Rome, New York, Rio Di Janero)

If I could limit it to one item per cell, a simple drop down data validation list would work, but I need to limit entry to 1 cell/column.

Any suggestions would be much appreciated.

 

[AlphaFrog]

You're welcome.

 

[oraclemontgo]

Hi AG,

sorry to be a pester :-0 Everything was working great. When I closed the spread you worked on with me as shown above and save it and opened it up today--the macros were not working. I enabled, then only column B allowed me to insert more than one selection followed by a comma. The others are not allowing. Also, I emailed it to a friend and she sent it back to me and it will not allow for this entry separated by a comma either.

Any ideas?

 

[KylerHunter]

AlphaFrog,

Please I need your help. I have multiple columns that will need to be able to do a Multi-Selection drop down list. The suggestions in the threads all seem to have code for specific column ranges. Is there a way to write the code so that any Drop Down List no matter where in the sheet it is will allow Multi Selection. As well as if someone deselects a choice it will be removed from the box?

I tried to modify myself but I've never worked with VBA so I don't have a clue as to what I'm doing.

I was using this but got errors. Please help

Private Sub Worksheet_Change(ByVal Target As Range)

Dim oldVal As String
Dim newVal As String

If Target.Count > 1 Then Exit Sub
If Intersect(Range Cells.SpecialCells(xlCellTypeAllValidation)), Target Is Nothing Then Exit Sub

On Error GoTo ReEnable
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal

If oldVal <> "" And newVal <> "" Then
Target.Value = oldVal & ", " & newVal
End If

ReEnable:
Application.EnableEvents = True
If Err.Number <> 0 Then MsgBox Err.Description, vbCritical, "Error " & Err.Number

End Sub

 

[AlphaFrog]

Hi KylerHunter and welcome to the forum.

You may find this link helpful
Excel Data Validation - Select Multiple Items


Try this...

[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Worksheet_Change([color=darkblue]ByVal[/color] Target [color=darkblue]As[/color] Range)
    [color=green]'Multiselection Data Validation dropdown list[/color]
    [color=green]'Selecting a list item toggles it from the selected entries[/color]
    
    [color=darkblue]Dim[/color] oldVal [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] newVal [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Const[/color] cDelimiter [color=darkblue]As[/color] [color=darkblue]String[/color] = ", "
    
    [color=darkblue]If[/color] Target.Count > 1 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=darkblue]If[/color] Target.Value = "" [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=darkblue]If[/color] Intersect(Me.Cells.SpecialCells(xlCellTypeAllValidation), Target) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=darkblue]If[/color] Target.Validation.Type <> xlValidateList [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] ReEnable
    Application.EnableEvents = [color=darkblue]False[/color]
    
    newVal = Target.Value
    Application.Undo
    oldVal = Target.Value
    
    [color=darkblue]If[/color] oldVal = "" [color=darkblue]Then[/color]
        [color=green]'First entry[/color]
        Target.Value = newVal
    [color=darkblue]Else[/color]
        [color=darkblue]If[/color] IsError(Application.Match(newVal, Split(oldVal, cDelimiter), 0)) [color=darkblue]Then[/color]
            [color=green]'add entry[/color]
            Target.Value = oldVal & cDelimiter & newVal
        [color=darkblue]Else[/color]
            [color=green]'remove entry[/color]
            newVal = Replace(cDelimiter & oldVal & cDelimiter, cDelimiter & newVal & cDelimiter, cDelimiter)
            newVal = Mid(newVal, Len(cDelimiter) + 1)
            [color=darkblue]If[/color] Len(newVal) [color=darkblue]Then[/color] newVal = Left(newVal, Len(newVal) - Len(cDelimiter))
            Target.Value = newVal
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
ReEnable:
    Application.EnableEvents = [color=darkblue]True[/color]
    [color=darkblue]If[/color] Err.Number <> 0 [color=darkblue]Then[/color] MsgBox Err.Description, vbCritical, "Error " & Err.Number
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[indrokneel]

Hi Alpha Frog.. This was brilliant. However this seems to pose a problem if I want multiple dropdown lists in another cell apart that M10 ... lets says i need to create two multiple dropdown for two different lists in cells M10 and N10.

Cheers
Indro

You could create a UserForm that has a multi-selects listbox. The UserForm could be triggered when the user select a specific cell or clicks a button.

This code will concatenate multiple selections from a Data Validation dropdown list (code source) in cell M10.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim oldVal As String
    Dim newVal As String
    
    If Target.Address(0, 0) <> "[COLOR=Red]M10[/COLOR]" Then Exit Sub

    On Error GoTo ReEnable
    Application.EnableEvents = False
    newVal = Target.Value
    Application.Undo
    oldVal = Target.Value
    Target.Value = newVal

    If oldVal <> "" And newVal <> "" Then
        Target.Value = oldVal & ", " & newVal
    End If
ReEnable:
    Application.EnableEvents = True
    
End Sub

 

[AlphaFrog]

Hi indrokneel and welcome to the forum.

Try this...

[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Worksheet_Change([color=darkblue]ByVal[/color] Target [color=darkblue]As[/color] Range)
    
    [color=darkblue]Dim[/color] oldVal [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] newVal [color=darkblue]As[/color] [color=darkblue]String[/color]
    
[B]    [color=darkblue]If[/color] Target.Count > 1 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=darkblue]If[/color] Intersect(Range("M10:N10"), Target) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color][/B]
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] ReEnable
    Application.EnableEvents = [color=darkblue]False[/color]
    newVal = Target.Value
    Application.Undo
    oldVal = Target.Value
    Target.Value = newVal
    
    [color=darkblue]If[/color] oldVal <> "" And newVal <> "" [color=darkblue]Then[/color]
        Target.Value = oldVal & ", " & newVal
    [color=darkblue]End[/color] [color=darkblue]If[/color]
ReEnable:
    Application.EnableEvents = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[KylerHunter]

Worked like a charm. Thank you so much. I've been looking for this solution for a while now. And thanks for replying so quickly. Very impressed.

 

[dazza247]

Hello,

I have found what I am looking for within this thread however I wondered if it was possible to amened it?

The code provided below is exactly what I need but is it possible to amend it so that you can deselect a selection and also amend it so that you cannot select something more than once to avoid duplication?

If one or both are possible I would greatly appreciate a solution, thank you in advance.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim oldVal As String
Dim newVal As String

If Target.Count > 1 Then Exit Sub
If Intersect(Range("Q8,K11,K14"), Target) Is Nothing Then Exit Sub

On Error GoTo ReEnable
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal

If oldVal <> "" And newVal <> "" Then
Target.Value = oldVal & ", " & newVal
End If

ReEnable:
Application.EnableEvents = True
If Err.Number <> 0 Then MsgBox Err.Description, vbCritical, "Error " & Err.Number

End Sub

 

[AlphaFrog]

Hello,

I have found what I am looking for within this thread however I wondered if it was possible to amened it?

The code provided below is exactly what I need but is it possible to amend it so that you can deselect a selection and also amend it so that you cannot select something more than once to avoid duplication?

If one or both are possible I would greatly appreciate a solution, thank you in advance.

If the code deselects an already selected item, it cannot add duplicates.

The code in post #44 should do what you want. It will work for any Data Validation DropDown list on the sheet. If you want it to be cell specific, change this line...
If Intersect(Me.Cells.SpecialCells(xlCellTypeAllValidation), Target) Is Nothing Then Exit Sub
To this...
If Intersect(Range("Q8,K11,K14"), Target) Is Nothing Then Exit Sub

 

[dazza247]

If the code deselects an already selected item, it cannot add duplicates.

The code in post #44 should do what you want. It will work for any Data Validation DropDown list on the sheet. If you want it to be cell specific, change this line...
If Intersect(Me.Cells.SpecialCells(xlCellTypeAllValidation), Target) Is Nothing Then Exit Sub
To this...
If Intersect(Range("Q8,K11,K14"), Target) Is Nothing Then Exit Sub

Thank you very much, this is exactly what I required.