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. The code I suggested is hardly exceptional. You could do a search and find countless code snipit examples to manipulate Listbox controls.

There are different methods to prevent multiple selections depending on how you ultimately design the userform. The example userform above has the ability to multiselect or switch to single select and has two listboxes. All that "user-level configuration" is usually not provided to the end user. A userform is usually designed to be one way or the other. So to write code to cover all selection-type options is more involved.

You may want to consider just having one multi-select listbox and then just populate the multi-selections to the worksheet. Two listboxes may be superfluous. But then again, I don't know what you're trying to accomplish.

 

[dcg38524]

Excellent idea, thank you for all your help and sound advice.

Regards,
Don

 

[dolphin116]

Hi,

I am new to this site and found your code extremely helpful. I have a column of data validation list that I want to make them accommodate multiple selections. I am hoping if you could please teach me how to apply the code to all cells in one single column (say, column J)?

Thanks a ton!

 

[dolphin116]

Hi AlphaFrog,

This is the code I was referring to.

Hi cvande and welcome to the forum. Good job on searching for a solution first.

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("Q8,K11,K14"), 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]If[/COLOR] Err.Number <> 0 [COLOR=darkblue]Then[/COLOR] MsgBox Err.Description, vbCritical, "Error " & Err.Number
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[AlphaFrog]

Hi dolphin116 and welcome to the forum.

No need to PM me. I get notified, like you, when there's a reply to this thread.
You may want to review the Forum Rules and make note of rule #18.

[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]
    
    [COLOR=darkblue]If[/COLOR] Target.Count > 1 [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    [color=red]If Target.Column <> 10 Then Exit Sub[/color] [COLOR=green]'Column J[/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
    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]If[/COLOR] Err.Number <> 0 [COLOR=darkblue]Then[/COLOR] MsgBox Err.Description, vbCritical, "Error " & Err.Number
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[oraclemontgo]

Hi, I am new to the forum and new to VBA/Excel. I have a small business project and needed some quick guidance.

I followed your coding example above and replaced the value "10" with "15" and Column "J" with "O". It seemed to work, but then I tried to add additional columns. Well, it quit working, so clearly I do not have a grasp of this. Additionally, I cannot get the original code to work, so I must not be entering it in the correct location for compiling.

2 part question

1) I would like this code below to work on Columns B, F & 0...how should the code read in this case?
2) Where do I enter this code--what view code section--for example, it gives me options for worksheet 1 such as "general" or worksheet etc. and then it had a drop down for change, selection, activate etc. I am unclear.

Thank you for your help in advance... AlphaFrog


Private Sub Worksheet_Change(ByVal Target As Range) Dim oldVal As String Dim newVal As String If Target.Count > 1 Then Exit Sub If Target.Column <> 10 Then Exit Sub 'Column J 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 oraclemontgo and welcome to the forum.

You don't have to worry about the "code section" drop downs. They are not for code locations.

[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]
    
    [color=darkblue]If[/color] Target.Count > 1 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [B][color=darkblue]If[/color] Intersect(Range("B:B,F:F,O:O"), 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]If[/color] Err.Number <> 0 [color=darkblue]Then[/color] MsgBox Err.Description, vbCritical, "Error " & Err.Number
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[oraclemontgo]

Awesome. thanks. it does not work, so I must be entering it in the wrong location. when I enter the view code and click worksheet1, it gives me a general coding box with declarations. I placed here and it changed to worksheet and change. pressed enter and debug and it does not work. what am I missing?

 

[AlphaFrog]

You're welcome.

It sounds like you put the code in the correct location if Sheet1 is the sheet you want it to work on.

If you had it working before with one column (Column O only), this new code should just replace that previous code.

You may want to save the file with the new code and then close Excel and restart Excel.

"pressed enter and debug"

Not sure what that exactly means. You have to make a change to one of the columns on the worksheet.

 

[oraclemontgo]

Thank you! It works great. Renaming and closing worked great--not sure why, but I guess that is the nature of the beast!