It's done with a scanner.... If you look at my form in my test file.
Scan in Job number(barcode)
Scan in Emp ID (barcode) ...
Click on Time in ...
Once Job is finished...
Scan in Job number(barcode)
Scan in Emp ID (barcode) ...
Click on Time Out ...
This Copy and move to another sheet...
So i can have the same job/emp id repeat the task on the same day (multiple session).
Kind regards
Can i set this to do automatic anytime i open the file ?
Or set this to perform once i click the TRANSFER
Thank you so much for helping me out. It work.
Hi All,
I have a Jobtime sheet1 with four column Job No. and Emp ID and Time in and Time out.
I want to move/transfer Job No. and Emp ID and Time in and Time out (Job No. and Emp ID and Time in and Time out if all value exist) from sheet 1
to sheet 2 and remove the value from sheet 1 also shift cell up(or remove row)
If Time out value is not present then don't move/transfer.
Hi All, please help me
I want to set vba to copy first 10 row from sheet 1 to sheet 2.
remove 10 row from sheet 1 (by delete cell up so i can do that again for the next ten row)
Thank you
Hi All,
Please help me with vba code for cut paste value from Jobtime sheet all row with condition that (both time in and out are complete) to Timesheet and leave the row with time out not finish alone.
Private Sub cmdTimein_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("JobTime")
'''find first empty row in database
''iRow = ws.Cells(Rows.Count, 1) _
'' .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number
If Trim(Me.EmpID.Value) = "" Then
Me.EmpID.SetFocus
MsgBox "Please enter a Employee ID"
Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = Me.EmpID.Value
ws.Cells(iRow, 2).Value = Me.txtEmp.Value
ws.Cells(iRow, 3).Value = Now
'clear the data
Me.EmpID.Value = ""
Me.txtEmp.Value = ""
Me.EmpID.SetFocus
End Sub
Private Sub cmdTimeout_Click()
Dim lRow As Long
Dim ws As Worksheet
Dim Emp
Dim MatchRow As String
Dim SearchTable As Range
Set SearchTable = Sheets("JobTime").Range("A2:A" & Sheets("JobTime").Range("A" & Rows.Count).End(xlUp).Row)
Set ws = Worksheets("JobTime")
Application.ScreenUpdating = False
With Sheets("JobTime")
If EmpID = "" Then
MsgBox "Please Scan your ID", vbCritical, "Alert"
Else
If txtEmp.Value = "" Then
MsgBox "Please Select an Job Number.", vbCritical, "Alert"
Else
If WorksheetFunction.CountIf(.Columns(1), txtEmp) = 0 Then
MsgBox " You are NOT Timed-in", vbCritical, "Employee Time-Out"
Else
MatchRow = Application.WorksheetFunction.Match(txtEmp.Value, .Range(SearchTable.Address), 0) + 1
If .Cells(MatchRow, 3).Value <> "" Then
MsgBox " You are Already Timed-Out", vbCritical, "Employee Time-in"
Else
.Cells(MatchRow, 3).Value = Now
End If
'Clear userform
txtEmp.Value = vbNullString
Me.EmpID.SetFocus
Application.ScreenUpdating = True
End If
End If
End If
End With
End Sub
Private Sub Trnsfr_Click()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Sheets("JobTime").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim MatchRow As String
Dim SearchTable As Range
Set SearchTable = Sheets("JobTime").Range("A2:A" & Sheets("JobTime").Range("A" & Rows.Count).End(xlUp).Row)
MatchRow = Application.WorksheetFunction.Match(txtEmp.Value, .Range(SearchTable.Address), 0) + 1
If .Cells(MatchRow, 3).Value <>
End If
Application.ScreenUpdating = True
End SubKind regards
Private Sub cmdLogin_Click()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Attendance")
Application.ScreenUpdating = False
With Sheets("Attendance")
If empid = "" Then
MsgBox "Please Scan your ID", vbCritical, "Alert"
Else
' Find emtpy row
lRow = ws.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
'Add data to worksheet
ws.Cells(lRow, "A") = Me.txtEmp.Value
ws.Cells(lRow, "A").Offset(, 1).Value = Now
ws.Cells(lRow, "A").Offset(, 3).Value = Date
ws.Cells(lRow, "A").Offset(, 4).Value = Me.empid.Value
'Clear userform
txtEmp.Value = vbNullString
Me.empid.SetFocus
Application.ScreenUpdating = True
End If
End With
End Sub
Private Sub CommandButton1_Click()
Dim lRow As Long
Dim ws As Worksheet
Dim Emp
Dim MatchRow As String
Dim SearchTable As Range
**** Set SearchTable = Sheets("Attendance").Range("A2:A" & Sheets("Attendance").Range("A" & Rows.Count).End(xlUp).Row)
**** Set SearchTable1 = Sheets("Attendance").Range("E2:E" & Sheets("Attendance").Range("E" & Rows.Count).End(xlUp).Row)
****This is where i don't no how to combine two search criteria
Set ws = Worksheets("Attendance")
Application.ScreenUpdating = False
With Sheets("Attendance")
If empid = "" Then
MsgBox "Please Scan your ID", vbCritical, "Alert"
Else
If txtEmp.Value = "" Then
MsgBox "Please Select an Job Number.", vbCritical, "Alert"
Else
If WorksheetFunction.CountIf(.Columns(1), txtEmp) = 0 Then
MsgBox " You are NOT Timed-in", vbCritical, "Employee Time-Out"
Else
**** MatchRow = Application.WorksheetFunction.Match(txtEmp.Value, .Range(SearchTable.Address), 0) + 1
**** MatchRow = Application.WorksheetFunction.Match(empid.Value, .Range(SearchTable1.Address), 0) + 1
**** If .Cells(MatchRow, 3).Value <> "" Then
**** MsgBox " You are Already Timed-Out", vbCritical, "Employee Time-in"
**** Else
.Cells(MatchRow, 3).Value = Now
**** This is where i don't know how to add code to accept new value if previous match record exist don't overrided it and insert in new cell where new search match
End If
'Clear userform
txtEmp.Value = vbNullString
Me.empid.SetFocus
Application.ScreenUpdating = True
End If
End If
End If
End With
End SubPlease help me with coding for time out portion. I need to code it so it would find and match value for Job Id and EmployID and time out..... Also need multiple session for identical Job ID and employID.
Option Explicit
Private Sub cmdTimein_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("JobTime")
'''find first empty row in database
''iRow = ws.Cells(Rows.Count, 1) _
'' .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number
If Trim(Me.EmpID.Value) = "" Then
Me.EmpID.SetFocus
MsgBox "Please enter a Employee ID"
Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = Me.EmpID.Value
ws.Cells(iRow, 2).Value = Me.JobNo.Value
ws.Cells(iRow, 3).Value = Now
ws.Cells(iRow, 6).Value = Date
'clear the data
Me.EmpID.Value = ""
Me.JobNo.Value = ""
Me.EmpID.SetFocus
End Sub
Private Sub cmdTimeout_Click()
Dim lRow As Long
Dim ws As Worksheet
Dim Emp
Dim MatchRow As String
Dim SearchTable As Range
Set SearchTable = Sheets("JobTime").Range("A2:A" & Sheets("JobTime").Range("A" & Rows.Count).End(xlUp).Row)
Set ws = Worksheets("JobTime")
Application.ScreenUpdating = False
With Sheets("JobTime")
If EmpID = "" Then
MsgBox "Please Scan your ID", vbCritical, "Alert"
Else
If JobNo.Value = "" Then
MsgBox "Please Select an Job Number.", vbCritical, "Alert"
Else
MatchRow = Application.WorksheetFunction.Match(JobNo.Value, .Range(SearchTable.Address), 0) + 1
.Cells(MatchRow, 3).Value = Now
End If
'Clear userform
JobNo.Value = vbNullString
Me.EmpID.SetFocus
Application.ScreenUpdating = True
End If
End With
End Sub