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]

This puts just the priority task in column E. All the selected tasks are stored in column P so as to restore all the selected items in the listbox when the user reselects the cell in column E.

The first time you run it, start with a fresh (empty in columns E and P) sheet for this to work. It wouldn't work with the previous way the data was stored on the sheet.

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] UserForm_Initialize()
    
    [COLOR=darkblue]With[/COLOR] ListBox1
        .List = Range("Progress").Value    [COLOR=green]'Range of cells with the list of tasks[/COLOR]
        .MultiSelect = fmMultiSelectMulti
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    UserForm1.Caption = "Select Completed Tasks"
    CommandButton1.Caption = "Okay"
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    
    
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] CommandButton1_Click()
    
    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], strTemp [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], strPriority [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Const[/COLOR] MySeparator [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR] = ", "
    [COLOR=darkblue]With[/COLOR] ListBox1
        [COLOR=green]'Read selections[/COLOR]
        [COLOR=darkblue]For[/COLOR] i = 0 [COLOR=darkblue]To[/COLOR] .ListCount - 1
            [COLOR=darkblue]If[/COLOR] .Selected(i) [COLOR=darkblue]Then[/COLOR]
                strPriority = .List(i)
                strTemp = strTemp & .List(i) & MySeparator
                .Selected(i) = [COLOR=darkblue]False[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]Next[/COLOR] i
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    [COLOR=darkblue]If[/COLOR] Len(strTemp) [COLOR=darkblue]Then[/COLOR]
        ActiveCell.Value = strPriority
        strTemp = Left(strTemp, Len(strTemp) - Len(MySeparator))
        Range("P" & ActiveCell.Row).Value = strTemp
    [COLOR=darkblue]Else[/COLOR]
        ActiveCell.ClearContents
        Range("P" & ActiveCell.Row).ClearContents
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
    UserForm1.Hide
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    
    
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] UserForm_Activate()
    [COLOR=green]'Match Listbox selections with ActiveCell selections[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] strCell [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Const[/COLOR] MySeparator [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR] = ", "
    strCell = Range("P" & ActiveCell.Row).Value & MySeparator
    [COLOR=darkblue]With[/COLOR] ListBox1
        [COLOR=darkblue]For[/COLOR] i = 0 [COLOR=darkblue]To[/COLOR] .ListCount - 1
            .Selected(i) = InStr(strCell, .List(i) & MySeparator)
        [COLOR=darkblue]Next[/COLOR] i
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    
    
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] UserForm_QueryClose(Cancel [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR], CloseMode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR])
    [COLOR=green]'Hide userform if Close "X" clicked[/COLOR]
    [COLOR=darkblue]If[/COLOR] CloseMode = 0 [COLOR=darkblue]Then[/COLOR]
        Cancel = [COLOR=darkblue]True[/COLOR]
        Me.Hide
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
End [COLOR=darkblue]Sub[/COLOR]

 

[HelpVBFrog]

I think your solution is even more useful than what I was trying to conceptualize! It works extremely well from what I can see.

Thank you so much AlphaFrog!

I'm just watching through some VBA tutorials, so hopefully in the future I can do some wicked stuff like this.

Your help was very much appreciated, I'm still kind of baffled that you responded so quickly hahaha.

 

[AlphaFrog]

You're welcome.

 

[MsTechie]

I surely hope someone can assist me. I have tried various codes that should allow for multiple options in a single cell, but none are working for me. I've gone through this forum and can semi-understand some of the coding, but am unable to apply it to my situation.

What I am trying to do is for a series of cells from Column C to Column G, is input a drop down list that will allow me to select multiple options. Right now it's only allowing for single option selections. I do believe that I have what fields I want included covered, however, I believe I am missing the source coding. My information is coming from Sheet 2 and the name of my List is ClaytonACTstaff and that data is D1:D9. I hope someone can assist me as this has stumped me for over a week. Thank you.



This is my current code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim oldVal As String, newVal As String


On Error GoTo exitHandler


'---Test to see if code should continue.
' Test statements could be combined, and are
' shown separately to simplify modification


If Target.Count > 1 Or Target.Text = "" Then Exit Sub


If Target.SpecialCells(xlCellTypeSameValidation) _
Is Nothing Then Exit Sub


'---modify to any valid range reference on activesheet
If Intersect(Target, Range("C:G")) _
Is Nothing Then Exit Sub


Application.EnableEvents = False
newVal = Target.Text
Application.Undo
oldVal = Target.Text
Target.Value = newVal
If oldVal = "" Then GoTo exitHandler


If oldVal = newVal Then
Target.Value = ""
ElseIf InStr(1, oldVal, newVal) > 0 Then
If Right(oldVal, Len(newVal)) = newVal Then
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
Else
Target.Value = Replace(oldVal, newVal & Chr(10), "")
End If
Else
Target.Value = oldVal & Chr(10) & newVal
End If


exitHandler:
Application.EnableEvents = True
End Sub

 

[AlphaFrog]

Start a new thread of your own and I'm sure someone will assist you.

 

[fleck]

Hi AlphaFrog,

I’m completely new to coding and this thread has really helped me produce my first Userform so thank you!

Using a thread I found here http://www.excel-easy.com/vba/examples/multiple-list-box-selections.html# (and added an OK button that they missed out) I’ve tried to take it to the next step and use two listboxes on the userform with add and remove buttons. However when I reopen the userform in a cell I’ve already populated with it previously, it doesn’t show the previous selections. You solved this on this option here. I tried using the same code you used below on my new userform but it hasn’t worked. I’d be very grateful for any help!

Thanks!

 

[AlphaFrog]

Can you show your code even if it doesn't work?
How are you populating the cell; comma separated values?

 

[dcg38524]

Hi AlphaFrog,

Apologies I do not want to break in on Fleck's query but I am also very curious in creating a Drop-down list w/multiple entries.

Using the example in the web link Fleck was kind enough to post: (see drop code below)
1) How would one use a lists of existing data starting in Cell "A2" until empty cell located in workbook TAB "Valid RAs" to be the data represented in left side of the Drop-Down list?
2) Then take only the newly selected data which will be then be on right side of the Drop-Down list and place that information in another cell range (B2:B) within the same workbook on TAB "Valid RAs"?

Any help is greatly appreciated,
Don

Private Sub UserForm_Initialize()

With ListBox1
    .AddItem "Sales"
    .AddItem "Production"
    .AddItem "Logistics"
    .AddItem "Human Resources"
End With

OptionButton3.Value = True

End Sub

 

[AlphaFrog]

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] UserForm_Initialize()
    
    [COLOR=green]'Cell "A2" until empty cell located in workbook TAB "Valid RAs"[/COLOR]
    [COLOR=green]'to be the data represented in left side of the Drop-Down list?[/COLOR]
    [COLOR=darkblue]With[/COLOR] Sheets("Valid RAs")
        Me.ListBox1.List = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    OptionButton3.Value = [COLOR=darkblue]True[/COLOR]
    
End [COLOR=darkblue]Sub[/COLOR]
    
    
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] CommandButton3_Click()  [COLOR=green]'New command button[/COLOR]
    
    [COLOR=green]'Right side of the Drop-Down list and place that information in another[/COLOR]
    [COLOR=green]'range (B2:B) within the same workbook on TAB "Valid RAs"[/COLOR]
    
    [COLOR=darkblue]If[/COLOR] Me.ListBox2.ListCount > 0 [COLOR=darkblue]Then[/COLOR] [COLOR=green]'Test if anything is in Listbox2[/COLOR]
        
        [COLOR=darkblue]With[/COLOR] Sheets("Valid RAs")
            [COLOR=green]'Clear old data in column B if any[/COLOR]
            [COLOR=darkblue]If[/COLOR] .Range("B2").Value <> "" [COLOR=darkblue]Then[/COLOR] .Range("B2", .Range("B" & Rows.Count).[COLOR=darkblue]End[/COLOR](xlUp)).ClearContents
            [COLOR=green]'Paste new listbox2 list to B2:B?[/COLOR]
            .Range("B2").Resize(Me.ListBox2.ListCount).Value = Me.ListBox2.List
            [COLOR=green]'Clear ListBox2[/COLOR]
            Me.ListBox2.Clear
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
End [COLOR=darkblue]Sub[/COLOR]

 

[dcg38524]

AlphaFrog,

Thank you, it works . As you suggested I created a "Submit" button to handle the user selection, and thanks to you that is working also "Data is place into the ("Valid RAs") Tab.

One thing, when the user makes their selection from the lift side of the Drop-Down list is it possible to stop them from being able to duplicate an already selected item?

You are truly awesome and I can see why your MrExcel MVP status is well deserved.

Kind regards,
Don