Copy cell value to multiple columns meeting useform listbox selection

[belbc]

I know this cannot be that hard but I do not know much about vba and such. I look around and usually find what I'm looking for from you all and then change it to make it work for me.
I have a workbook with several worksheet in it worksheet of emergency runs that I keep for pay for my firefighters. I have had this workbook for a few years now and was just trying to update it a little. I normally just click on the line and add the new run and put in each individuals pay for the run. Once done the pay and run info is automatically copied to appropriate sheets for a summary report. Like i said I'm trying to update this with a Data Entry Form.

The call entry part works well and populates the worksheet. The listbox on the right will populate with the names and call numbers of my firefighters. I do that with a RowSource property with a range name of "FFRoster". It shows some blanks line that I would like to remove but no big deal.

What I would like for to happen is when I click the "Save" button the info is placed in the worksheet "Master" and copy a value from a cell and paste it in the columns of the firefighters selected in the listbox.

I would like this "Pay/Run" value to be copied to all the columns of the firefighter that were selected in the listbox.

 

[mumps]

I am having trouble trying to find what type of controls you used in lstFF. They appear to be check boxes with captions corresponding to names but they don't behave like checkboxes. How did you create the check boxes?

 

[belbc]

In properties window under List Style chose option 1 fmListStyleOption. Did not make individual check boxes from each name. Also under properties MultiSelect chose option 1-fmMultiSelectMulti.

 

[belbc]

Looking around it might be easier to come up with the code if i built checkboxes for each person

 

[mumps]

I think it would be easier. Could you modify the file and upload a revised copy?

 

[belbc]

https://www.dropbox.com/s/t7lmc8ebjgj3t6v/LFD%20Payroll%202023%20Test%20with%20Form%20Upload%20with%20Checkboxes.xlsm.xlsx?dl=0

 

[mumps]

Again I am having trouble opening the file. It displays as having two extensions - xlsm.xlsx. I tried renaming it with one extension (xlsm), but it still doesn't work. Could your try to re-save the file with a different name and "xlsm" and uploading it again?

 

[belbc]

https://www.dropbox.com/s/m3gapqs3sjvstta/Pay%20Test.xlsm?dl=0

 

[mumps]

I managed to open it this time. I'm busy today so I will respond tomorrow with a possible solution.

 

[belbc]

I managed to open it this time. I'm busy today so I will respond tomorrow with a possible solution.

Okay Thanks for your time

 

[mumps]

Replace the current macro with the one below. Please note that this will work only when you click the "Save" button on the userform.

Private Sub cmdSave_Click()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Master")
    Dim lr As Long, c As MSForms.Control, fnd As Range
    lr = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    ''''''''''''''Add data in Run List''''''''''''''
    With sh
        .Cells(lr + 1, "A").Value = Me.txtDate.Value
        .Cells(lr + 1, "B").Value = Me.txtAddress.Value
        .Cells(lr + 1, "C").Value = Me.cmbCallType.Value
        .Cells(lr + 1, "D").Value = Me.txtDescription.Value
        .Cells(lr + 1, "E").Value = Me.txtDispatch.Value
        .Cells(lr + 1, "F").Value = Me.txtInQuarters.Value
        .Cells(lr + 1, "I").Value = Me.txtRunNumber.Value
        For Each c In Me.Controls("Frame4").Controls
            If TypeName(c) = "CheckBox" Then
                If c.Value = True Then
                    Set fnd = .Rows(7).Find(Mid(c.Caption, WorksheetFunction.Find(" ", c.Caption) + 2, 999), LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        .Cells(lr + 1, fnd.Column) = .Range("H" & lr + 1)
                    End If
                End If
            End If
        Next c
    End With
    ''''''''''''''Clear Boxes'''''''''''''
    Me.txtSearch.Value = ""
    Me.txtDate.Value = ""
    Me.txtAddress.Value = ""
    Me.cmbCallType.Value = ""
    Me.txtDescription.Value = ""
    Me.txtDispatch.Value = ""
    Me.txtInQuarters.Value = ""
 to Master list", vbInformation
    txtDate.SetFocus
    Application.ScreenUpdating = True
End Sub
    Me.txtRunNumber.Value = ""
    Call Refresh_data
    MsgBox "Run has been added