User form - select multiple choices in a combobox?

[mnoah]

I cannot thank this board enough! This is my first major post/request. (Many thanks to Rick and AlphaFrog for their contributions to this)

So, I have a userform to record very simple payroll data. The user selects a worker (individual), work performed, and then enters a quantity (hours/pieces) and clicks SUBMIT. The data then gets sent to the matching 'job' worksheet, finds the workers name in column A and places the quantity in the next empty column.

The user can only select ONE worker at a time using a combobox. The combobox pulls in worker names from a list defined in one of the worksheets.

My question: Is it possible for the user to select multiple workers? Since many workers work on the same job at a time, it would be easier to be able to select as many workers worked on that same job. The quantity would be the same. I'm just having a rough time figuring out how to manipulate the VBA to accomplish this if I use checkboxes and how it would populate from the 'names' list. Here is an image of my userform and workbook, code for SUBMIT is below.

Private Sub CommandButton1_Click()
    Dim Found As Range
    
    'If statements check which worksheet to activate and, thus, send data to
    If ComboBox2.Value = "Bites" Then
    Worksheets("ThorLab Bites").Activate
    ElseIf ComboBox2.Value = "Cleaning" Then
    Worksheets("Cleaning").Activate
    ElseIf ComboBox2.Value = "Boxes" Then
    Worksheets("ThorLab Boxes").Activate
    ElseIf ComboBox2.Value = "Snacks" Then
    Worksheets("ThorLab Snacks").Activate
    ElseIf ComboBox2.Value = "Shredding" Then
    Worksheets("Shredding").Activate
    ElseIf ComboBox2.Value = "Global" Then
    Worksheets("Global").Activate
    ElseIf ComboBox2.Value = "Gloves" Then
    Worksheets("Gloves").Activate
    ElseIf ComboBox2.Value = "Laundry" Then
    Worksheets("Laundry").Activate
    
    
    End If
    'finds matching name, then sends data to the right side in the nearest empty cell
    If Me.TextBox3.Value = "" Then
        MsgBox "Nothing entered ", , "Missing Entry"
    Else
        Set Found = ActiveSheet.Range("A:A").Find(What:=Me.ComboBox1.Value, _
                                                       LookIn:=xlValues, _
                                                       LookAt:=xlWhole, _
                                                       SearchOrder:=xlByRows, _
                                                       SearchDirection:=xlNext, _
                                                       MatchCase:=False)
        If Found Is Nothing Then
            MsgBox "No match for " & Me.ComboBox2.Value, , "No Match Found"
        ElseIf MsgBox("You are about to submit the following pieces/hours for " & Me.ComboBox1.Value & ": " & Me.TextBox3.Value & vbNewLine & vbNewLine & "Is this correct?", vbYesNo, "Is this correct?") = vbNo Then Exit Sub
        Else
            ActiveSheet.Cells(Found.Row, Columns.Count).End(xlToLeft).Offset(, 1).Value = Me.TextBox3.Value
        End If
    End If
    Call UserForm_Initialize
    
    
End Sub

 

[mnoah]

Bump. Could anyone lend their thoughts and expertise? It only works when the "Individual" list is set to only allow one selection. Below is an image of what I want to occur. The SUBMIT button should find each name in the worksheet, then send the "Hours/Pieces" quantity to the right nearest column for each person selected/found.

 

[My Aswer Is This]

I'm working on this. Will get back with you in a day or two. I'm always looking for a challenge.

 

[mnoah]

I actually solved this late last night and was going to post first thing this morning! Thanks to My Answer Is This and mikerickson for their contributions. Code is below. Please take a look if you can see anything that could be tidied up. Eventually I'll want to make some more improvements to include a date on the userform and only allow entries to go to selected date columns in the job worksheets, but I am really happy with this right now.

I'm working on this. Will get back with you in a day or two. I'm always looking for a challenge.

Private Sub submitButton_Click()


Dim Found As Range
Dim i As Long
Dim msg As String
Dim Check As String
    
   
    
        With multiSelectListBox
            For i = 0 To .ListCount - 1
                If .Selected(i) Then
                msg = msg & .List(i) & vbNewLine
                End If
                Next i
                End With
          
          If msg = vbNullString Then
         'If nothing was selected, tell user and let them try again
        MsgBox "Nothing was selected!  Please select an individual(s)!"
        Exit Sub
    Else
         'Ask the user if they are happy with their selection(s)
        Check = MsgBox("You selected:" & vbNewLine & msg & vbNewLine & _
        "Are you happy with your selections?", _
        vbYesNo + vbInformation, "Please confirm")
    End If
     
    If Check = vbNo Then
         'clears data and starts over
       For i = 0 To multiSelectListBox.ListCount - 1
            multiSelectListBox.Selected(i) = False
       Next
    End If
          
    'Checks to make sure a job was selected
    If IsNull(ComboBox2) Then
            MsgBox "No Job Selected!"
    Exit Sub
    End If
    
    If TextBox3.Value = "" Then
    MsgBox "No Quantity Entered!"
    Exit Sub
    End If
    
    Worksheets(ComboBox2.Value).Activate
          
            
            With multiSelectListBox
            For i = 0 To .ListCount - 1
                If .Selected(i) Then
                'finds all matching names in worksheet that were selected in the userform
                Set Found = ActiveSheet.Range("A:A").Find(What:=Me.multiSelectListBox.List(i), _
                                                                                LookIn:=xlValues, _
                                                                                LookAt:=xlWhole, _
                                                                            SearchOrder:=xlByRows, _
                                                                            SearchDirection:=xlNext, _
                                                                                MatchCase:=False)
                
              
                ActiveSheet.Cells(Found.Row, Columns.Count).End(xlToLeft).Offset(, 1).Value = Me.TextBox3.Value
                Else
                multiSelectListBox.Selected(i) = False
                End If
            Next i
            End With
End Sub

 

[My Aswer Is This]

I found this part of the script caused things to be very slow:
Set Found = ActiveSheet.Range("A:A").Find(What:=Me
I think it should only search Column "A" till the last used row in Clumn "A"

 

[My Aswer Is This]

Your script works great.
Since you asked for suggestion here is one
"Active Sheet" is not really needed.
Instead of activating the sheets you can do something like this:

Set Found = Worksheets(ComboBox2.Value) ....

Worksheets(ComboBox2.Value).Cells(Found.Row,.....