Touch screen in and out with Excel

Touch screen in and out with Excel. Record in and out times with touch screen. Keep track of time spent on each job. Check out my online courses
All my courses include online support and a user manual
Let me teach you the VBA that I have learn in my five years of consulting

Let’s take the frustration out of user forms

Become an Affiliate and earn 25% on Course Sales

For more help visit my website or email me at

Contact me regarding customizing this template for your needs.

Click for online Excel Consulting

Follow me on Facebook


Follow me on twitter

You can help and generate a translation to you own language

*this description may contain affiliate links. When you click them, I may receive a small commission at no extra cost to you. I only recommend products and services that I’ve used or have experience with.

code for worksheet
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Cancel = True

If Not Intersect(Target, Range(“A2:b1000”)) Is Nothing Then

Target.Interior.ColorIndex = 4
Call timeinandout
End If
End Sub

code for modules
Sub timeinandout()
Dim Ename As String
Dim JobNumber As String
Dim rng As Range
Dim rownumber As Long
Dim Total As Double
Dim Timein As Date
Dim Timeout As Date
Dim ws As Worksheet
Dim name As String
Dim now As Date
Dim col As Long

If ActiveCell.Interior.ColorIndex = 4 Then
col = ActiveCell.Column
If col = 1 Then
rownumber = ActiveCell.Row
If ActiveCell.Offset(0, 3).Value (does not equal) “” Then
MsgBox “Previously Signed In”
GoTo ende
End If
JobNumber = ActiveCell.Offset(0, 2).Value
ActiveCell.Offset(0, 3).Select
ActiveCell.Value = Date & ” ” & Time
ActiveCell.NumberFormat = “d/m/yyyy h:mm AM/PM”
GoTo ende
End If
If col = 2 Then
If ActiveCell.Offset(0, -1).Interior.ColorIndex (does not equal) 4 Then
MsgBox “Must be signed in before signing out”
ActiveCell.Interior.ColorIndex = 0

GoTo ende
End If
If ActiveCell.Offset(0, 3).Value (does not equal) “” Then
MsgBox “Previously Signed Out”
GoTo ende
End If
rownumber = ActiveCell.Row
JobNumber = ActiveCell.Offset(0, 1).Value
ActiveCell.Offset(0, 3).Select
ActiveCell.Value = Date & ” ” & Time
ActiveCell.NumberFormat = “d/m/yyyy h:mm AM/PM”
Timein = CDate(Cells(rownumber, 4).Value)
Timeout = CDate(Cells(rownumber, 5).Value)
Total = TimeValue(Timeout) – TimeValue(Timein)
Debug.Print Total
Debug.Print Format(Total, “hh:mm:ss”)
Cells(rownumber, 6).NumberFormat = “hh:mm:ss”
Cells(rownumber, 6).Value = Total
Call totalhours(JobNumber, Total, Timeout)
End If

End If
End Sub

Sub totalhours(JobNumber, Total, Timeout)
Dim lastline As Long
Dim rng, rg As Range
Dim ws As Worksheet
Dim work As Range
Dim sumx, r As Long
Dim exists As Boolean
Dim tottime As Date
Dim newtime As Date

‘Check if this jobnumber is unique
For i = 1 To Worksheets.Count
If Worksheets(i).name = JobNumber Then
exists = True
GoTo already
End If
Next i

If Not exists Then
‘if doesnot exist create a new sheet with named the jobnumber
With ThisWorkbook
Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count)) = JobNumber
End With
ws.Range(“A1”).Value = “Date”
ws.Range(“A2”).Value = Timeout
ws.Range(“A2”).NumberFormat = “d/m/yyyy”
ws.Range(“B1”).Value = “Time”
ws.Range(“B2”).Value = Total

ws.Range(“B2”).NumberFormat = “hh:mm:ss”
ws.Range(“C1”).Value = “Total time”

ws.Range(“C2”).Value = Total
ws.Range(“C2”).NumberFormat = “hh:mm:ss”
GoTo ende
End If
‘if it exists add total hours to the lastline of sheet of that name

lastrow = Sheets(JobNumber).Cells(Rows.Count, 1).End(xlUp).Row + 1
Set ws = ActiveWorkbook.Sheets(JobNumber)

‘add the total hours to the column
ws.Cells(lastrow, 1).Value = Timeout
ws.Cells(lastrow, 1).NumberFormat = “d/m/yyyy”
ws.Cells(lastrow, 2).Value = Total
ws.Cells(lastrow, 2).NumberFormat = “hh:mm:ss”
ws.Cells(lastrow, 3).Value = ws.Cells(lastrow, 2).Value + ws.Cells(lastrow, 3).Offset(-1, 0).Value
ws.Cells(lastrow, 3).NumberFormat = “hh:mm:ss”

End Sub

Watch more new videos about Excel Office | Synthesized by Mindovermetal English

Rate this post

Bài viết liên quan

Theo dõi
Thông báo của
1 Comment
Cũ nhất
Mới nhất Được bỏ phiếu nhiều nhất
Phản hồi nội tuyến
Xem tất cả bình luận
arykl Anees