Touch screen in and out with Excel

Let’s take the frustration out of user forms

Become an Affiliate and earn 25% on Course Sales

For more help visit my website www.easyexcelanswers.com or email me at easyexcelanswers@gmail.com.

Contact me regarding customizing this template for your needs.

Click for online Excel Consulting

Follow me on Facebook

TWEET THIS VIDEO

Follow me on twitter
easyexcelanswers

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
ende:
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))
ws.name = 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

already:
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”

ende:
Sheet1.Activate
End Sub

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