I am not sure if your design for table1 is efficient for extracting the hours, but I leave that up to you. In order to record the hours I have added columns inbetween the name columns
| Table1 | | | | Table4 | | | | | | | | | |
| Worker names | | | | Worker Supervisor | WS hours | Worker1 | W1 Hours | Worker2 | W2 Hours | Worker3 | W3 Hours | Worker4 | W4 Hours |
| KEVIN | | | | KEVIN | 8 | NIMA | | MATTHEW | | GARY | | TIMOTHY | 4,5 |
| NIMA | | | | NIMA | | MATTHEW | | GARY | 4 | TIMOTHY | 2 | JOSE | 2 |
| MATTHEW | | | | MATTHEW | 7 | GARY | | TIMOTHY | 4 | JOSE | | LARRY | 4,5 |
| GARY | | | | GARY | | TIMOTHY | 2 | JOSE | | LARRY | 5 | JEFFREY | 5 |
| TIMOTHY | | | | TIMOTHY | | JOSE | | LARRY | | JEFFREY | 6 | FRANK | 4,333333333 |
| JOSE | | | | JOSE | | LARRY | 5 | JEFFREY | | FRANK | | SCOTT | 0 |
| LARRY | | | | LARRY | 5 | JEFFREY | 6 | FRANK | 3 | SCOTT | 7 | ERIC | 7 |
| JEFFREY | | | | JEFFREY | | FRANK | | SCOTT | | ERIC | 7 | STEPHEN | 7 |
| FRANK | | | | FRANK | | SCOTT | 7 | ERIC | 3 | STEPHEN | | ANDREW | 0 |
| SCOTT | | | | SCOTT | | ERIC | 7 | STEPHEN | 3 | ANDREW | | RAYMOND | 0 |
| ERIC | | | | ERIC | | STEPHEN | | ANDREW | 6 | RAYMOND | 4 | GREGORY | 4 |
| STEPHEN | | | | STEPHEN | | ANDREW | | RAYMOND | | GREGORY | 5 | KEVIN | 5 |
| ANDREW | | | | ANDREW | | RAYMOND | | GREGORY | 6 | KEVIN | 6 | NIMA | 6 |
| RAYMOND | | | | RAYMOND | | GREGORY | 7 | KEVIN | | NIMA | 7 | MATTHEW | 7 |
| GREGORY | | | | GREGORY | | KEVIN | | NIMA | 6 | MATTHEW | 8 | GARY | 8 |
| Peter | | | | | | | | | | | | | |
<tbody>
</tbody>
Then I have made a userform with a combobox for the names and a textbox for the time entry. An OK button to add the time to the name and a Close button to close the form.
image sharing
The combobox I gave the name cbxNames, the textbox tbxHours, the 'Copy to sheet' button btnOK, the cancel button btnCancel
This leads to the following userform code to make it work:
Code:
Option Explicit
Private Sub btnCancel_Click()
Unload Me
End Sub
Private Sub btnOK_Click()
'find name in table1 and add hours in column behind
Dim rFound As Range
Dim vSp As Variant
vSp = Split(tbxHours, ":")
Set rFound = ActiveSheet.ListObjects("Table1").DataBodyRange.Find(what:=cbxNames)
rFound.Offset(0, 1) = vSp(0) + vSp(1) / 60
End Sub
Private Sub tbxHours_Enter()
tbxHours = ""
End Sub
Private Sub tbxHours_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(tbxHours.Value) = 0 Then
tbxHours.Value = "00:00"
ElseIf Len(tbxHours.Value) = 4 Then
tbxHours.Value = "0" & tbxHours.Value
End If
If IsDate(tbxHours.Value) And Len(tbxHours.Text) = 5 Then
Else
MsgBox "Input Hour like this Example 05:35"
tbxHours.Text = "00:00"
End If
End Sub
Private Sub UserForm_Initialize()
With cbxNames
.RowSource = Blad2.ListObjects("Table4").ListColumns(1).DataBodyRange.Address
End With
tbxHours = "00:00"
End Sub