Populate a single sheet with multiple entries from a drop down list

Hi this is my first posting on here so I am hoping someone is kind enough to help me. I am OK at putting a drop down validation list in my Excel 2007 spreadsheet but what I want to do is be able to chose multiple choices and these choices made populate a single cell followed by a comma each time a choice is made.
Sorry the title should read Single Cell not Single Sheet !! oops a senior moment

Zuerner,

Welcome to the forum!
So if you have headers in row 1 and actual data starts in row 2, and the drop-down validation lists are in columns, A B and C, then in cell D2 and copied down you could have:

=MID(IF(A2="","",", "&A2)&IF(B2="","",", "&B2)&IF(C2="","",", "&C2),3,99)

Is something like that what you mean?

I'm still a little confused so...

To best describe or illustrate your problem you would be better off attaching a dummy workbook, the workbook should contain the same structure and some dummy data of the same type as the type you have in your real workbook - so, if a cell contains numbers & letters in this format abc-123 then that should be reflected in the dummy workbook.

If needed supply a before and after sheet in the workbook so the person helping you can see what you are trying to achieve.
To attach a file, click the "Go Advanced" button and then click the paperclip icon to open the Manage Attachments dialog.

Martin,

I think I get it now. You want to choose multiple names from the drop-down list to populate the cell the drop-down list is in. If that is the case, you're going to have to use VBA. Are you ok with a VBA solution?

Martin,

Attached is a modified version of your sample file. I have made a lot of changes.
First of all, you'll notice the 'Rota' sheet now has a different layout. You can enter the date of the Week Commencing in cell B1, and the days of the week in B3:F3 will automatically update. They are formatted to show the day of the week as well as the date.

Secondly, I renamed sheet 'Data' to be 'Lists'. In B1 is the header "Names" and starting in cell B2 and going down without skipping any rows (so no blanks in the list) is the list of names. I also edited the named ranged "names". It is now named "list_Names" and is a dynamic named range that is defined with this formula:

=Lists!$B$2:INDEX(Lists!$B:$B,COUNTA(Lists!$B:$B))

The reason it uses column B is because column A is hidden. It is a reserved column for the userform so that it can sort the name lists as names get shuffled around between assigned and unassigned.


Next is where the VBA stuff starts. I used the worksheet_selectionchange event for sheet 'Rota'. The event will only trigger when a single cell withing B4:F6 is selected. Techincally its B4:F(last row), but the last row in this example is 6. The code used for the selectionchange event is:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Application.EnableEvents = False
    On Error GoTo ReEnable
    
    If Target.Cells.Count = 1 And Not Intersect(Target, Me.Range("B4:F" & Me.Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing Then
        Load frm_AssignDuty
        frm_AssignDuty.Show
    End If
    
ReEnable:
    Application.EnableEvents = True
    
End Sub

What that code does is pull up the userform named frm_AssignDuty. That is a userform I created that contains 2 listboxes and some buttons. The left-hand listbox is the list of unassigned names. The right-hand listbox is the list of assigned names. So the form opens, you can choose whichever unassigned names you want and move them over to the assigned names and click OK, which will fill the selected cell with the list of names and close the form. You don't have to use the ">" and "<" buttons to move names over, you can also double-click on a name and it will get moved that way, so both options are available (double-clicking and using the buttons). Pressing cancel will close the form without making any changes to the cell. The list of unassigned names is based on the list of full names and then it removes any names that have already been assigned in the same column. For example, if in cell B4 you assign Name01 and Name03, then in cell B5 those two names will no longer be available because they have already been assigned. If you want to free a name up again, click on cell B4 and unassign the name.

Here is the full code used by the userform:

Private Sub btn_AssignAll_Click()
    
    Dim wsList As Worksheet
    Dim wsRota As Worksheet
    
    Set wsList = Sheets("Lists")
    Set wsRota = Sheets("Rota")
    
    wsList.Range("A1").Resize(Me.list_UnassignedNames.ListCount).Value = Me.list_UnassignedNames.List
    If Me.list_AssignedNames.ListCount > 0 Then wsList.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(Me.list_AssignedNames.ListCount).Value = Me.list_AssignedNames.List
    With wsList.Range("A1", wsList.Cells(Rows.Count, "A").End(xlUp))
        .Sort .Cells, xlAscending, Header:=xlNo
        Me.list_UnassignedNames.Clear
        Me.list_AssignedNames.Clear
        Select Case (.Cells.Count > 1)
            Case True:  Me.list_AssignedNames.List = .Value
            Case Else:  Me.list_AssignedNames.AddItem .Value
        End Select
        .ClearContents
    End With
    
    Me.btn_AssignAll.Enabled = False
    Me.btn_AssignSelected.Enabled = False
    Me.btn_UnassignAll.Enabled = True
    Me.btn_UnassignSelected.Enabled = True
    
    Set wsList = Nothing
    Set wsRota = Nothing
    
End Sub

Private Sub btn_AssignSelected_Click()
    
    Dim wsList As Worksheet
    Dim wsRota As Worksheet
    Dim i As Long
    Dim bEnabled As Boolean
    
    Set wsList = Sheets("Lists")
    Set wsRota = Sheets("Rota")
    
    If Me.list_AssignedNames.ListCount > 0 Then wsList.Range("A1").Resize(Me.list_AssignedNames.ListCount).Value = Me.list_AssignedNames.List
    With Me.list_UnassignedNames
        For i = .ListCount - 1 To 0 Step -1
            If .Selected(i) Then
                wsList.Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = .List(i)
                .RemoveItem i
            End If
        Next i
    End With
    
    With wsList.Range("A1", wsList.Cells(Rows.Count, "A").End(xlUp))
        .Sort .Cells, xlAscending, Header:=xlNo
        Me.list_AssignedNames.Clear
        Select Case (.Cells.Count > 1)
            Case True:  Me.list_AssignedNames.List = .Value
            Case Else:  Me.list_AssignedNames.AddItem .Value
        End Select
        .ClearContents
    End With
    
    If Me.list_UnassignedNames.ListCount > 0 Then
        bEnabled = (Len(Me.list_UnassignedNames.List(0)) > 0)
    End If
    
    Me.btn_AssignAll.Enabled = bEnabled
    Me.btn_AssignSelected.Enabled = bEnabled
    Me.btn_UnassignAll.Enabled = True
    Me.btn_UnassignSelected.Enabled = True
    
    Set wsList = Nothing
    Set wsRota = Nothing
    
End Sub

Private Sub btn_UnassignAll_Click()
    
    Dim wsList As Worksheet
    Dim wsRota As Worksheet
    
    Set wsList = Sheets("Lists")
    Set wsRota = Sheets("Rota")
    
    wsList.Range("A1").Resize(Me.list_AssignedNames.ListCount).Value = Me.list_AssignedNames.List
    If Me.list_UnassignedNames.ListCount > 0 Then wsList.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(Me.list_UnassignedNames.ListCount).Value = Me.list_UnassignedNames.List
    With wsList.Range("A1", wsList.Cells(Rows.Count, "A").End(xlUp))
        .Sort .Cells, xlAscending, Header:=xlNo
        Me.list_AssignedNames.Clear
        Me.list_UnassignedNames.Clear
        Select Case (.Cells.Count > 1)
            Case True:  Me.list_UnassignedNames.List = .Value
            Case Else:  Me.list_UnassignedNames.AddItem .Value
        End Select
        .ClearContents
    End With
    
    Me.btn_AssignAll.Enabled = True
    Me.btn_AssignSelected.Enabled = True
    Me.btn_UnassignAll.Enabled = False
    Me.btn_UnassignSelected.Enabled = False
    
    Set wsList = Nothing
    Set wsRota = Nothing
    
End Sub

Private Sub btn_UnassignSelected_Click()
    
    Dim wsList As Worksheet
    Dim wsRota As Worksheet
    Dim i As Long
    Dim bEnabled As Boolean
    
    Set wsList = Sheets("Lists")
    Set wsRota = Sheets("Rota")
    
    If Me.list_UnassignedNames.ListCount > 0 Then wsList.Range("A1").Resize(Me.list_UnassignedNames.ListCount).Value = Me.list_UnassignedNames.List
    With Me.list_AssignedNames
        For i = .ListCount - 1 To 0 Step -1
            If .Selected(i) Then
                wsList.Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = .List(i)
                .RemoveItem i
            End If
        Next i
    End With
    
    With wsList.Range("A1", wsList.Cells(Rows.Count, "A").End(xlUp))
        .Sort .Cells, xlAscending, Header:=xlNo
        Me.list_UnassignedNames.Clear
        Select Case (.Cells.Count > 1)
            Case True:  Me.list_UnassignedNames.List = .Value
            Case Else:  Me.list_UnassignedNames.AddItem .Value
        End Select
        .ClearContents
    End With
    
    If Me.list_AssignedNames.ListCount > 0 Then
        bEnabled = (Len(Me.list_AssignedNames.List(0)) > 0)
    End If
    
    Me.btn_AssignAll.Enabled = True
    Me.btn_AssignSelected.Enabled = True
    Me.btn_UnassignAll.Enabled = bEnabled
    Me.btn_UnassignSelected.Enabled = bEnabled
    
    Set wsList = Nothing
    Set wsRota = Nothing
    
End Sub

Private Sub list_UnassignedNames_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
    btn_AssignSelected_Click
    
End Sub

Private Sub list_AssignedNames_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
    btn_UnassignSelected_Click
    
End Sub

Private Sub btn_OK_Click()
    
    Dim wsList As Worksheet
    Dim wsRota As Worksheet
    Dim i As Long
    
    Set wsList = Sheets("Lists")
    Set wsRota = Sheets("Rota")
    
    With Me.list_AssignedNames
        If .ListCount > 0 Then
            Select Case (Len(.List(0)) > 0)
                Case True: Selection.Value = Replace(Trim(Join(Application.Transpose(.List), "   ")), "   ", ", ")
                Case Else: Selection.ClearContents
            End Select
        Else
            Selection.ClearContents
        End If
    End With
    
    Set wsList = Nothing
    Set wsRota = Nothing
    
    Unload Me
    
End Sub

Private Sub btn_Cancel_Click()
    
    Unload Me
    
End Sub

Private Sub UserForm_Initialize()
    
    Dim wsList As Worksheet
    Dim wsRota As Worksheet
    Dim rCell As Range
    Dim strUsedNames As String
    Dim strUnassignedNames As String
    Dim strDate As String
    Dim strJob As String
    
    Set wsList = Sheets("Lists")
    Set wsRota = Sheets("Rota")
    
    For Each rCell In wsRota.Range(wsRota.Cells(4, Selection.Column), wsRota.Cells(Rows.Count, "A").End(xlUp).Offset(, Selection.Column - 1)).Cells
        Select Case (rCell.Address = Selection.Address)
            Case True:  Me.list_AssignedNames.List = Split(rCell.Text, ", ")
            Case Else:  strUsedNames = strUsedNames & ", " & rCell.Text & ", "
        End Select
    Next rCell
    
    For Each rCell In wsList.Range("list_Names").Cells
        If InStr(1, strUsedNames, rCell.Text, vbTextCompare) = 0 Then
            strUnassignedNames = strUnassignedNames & ", " & rCell.Text
        End If
    Next rCell
    
    With Me.list_UnassignedNames
        .List = Split(Mid(strUnassignedNames, 3), ", ")
        Me.btn_AssignAll.Enabled = (.ListCount > 0)
        Me.btn_AssignSelected.Enabled = (.ListCount > 0)
    End With
    
    With Me.list_AssignedNames
        Me.btn_UnassignAll.Enabled = (.ListCount > 0)
        Me.btn_UnassignSelected.Enabled = (.ListCount > 0)
    End With
    
    strDate = wsRota.Cells(3, Selection.Column).Text
    strJob = wsRota.Cells(Selection.Row, "A").Text
    Me.Caption = Me.Caption & strJob & " for " & strDate
    Me.lbl_Title.Caption = strJob & ": " & strDate
    
    Set wsList = Nothing
    Set wsRota = Nothing
    
End Sub

Private Sub UserForm_Terminate()
    Unload Me
End Sub

That's fantastic thank you so, so much, it's so much better doing it your way than the way I was thinking of doing it, or rather hoping to do it! Thanks again..Martin

The code will already expand dynamically. Its based off of the contents in column A. So if column A is populated, that row will trigger the code.