Time Stamp

[sm8392]

Hello everyone!

I'm currently working on a Macro-enabled Timesheet for my job where the employees can click a button to record the time they come in to work and leave.

I have 4 fields that require a timestamp per day (Clock in for the day, clock out for lunch, clock in from lunch, and clock out for the day).

I also have two additional buttons that are used to mark a particular day as a holiday or vacation.

I'm trying to protect the worksheet so that the employees cannot alter or delete an entry so I unchecked the option to allow users to select locked/unlocked cells, but when I do so it does not allow the user to select the cell where they will have the timestamp recorded (Example below).

Date	Time In	Time Out (Lunch)	Time In (Lunch)	Time Out
06/08/2018
06/09/2018

<tbody>
</tbody>

This is the code that I have for the Clock In/Out button:

Sub EnterTime()
ActiveSheet.Unprotect Password:="password"
Dim DT
'
' MyTimeStamp Macro
'
' Keyboard Shortcut: Ctrl+t
'


DT = Format(Now, "hh:mm:ss AM/PM")
ActiveCell.Select
Selection.NumberFormat = "hh:mm AM/PM"
ActiveCell.Value = DT
ActiveSheet.Protect Password:="password", _
DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

The issue that I am having is that it is not entering the timestamp in the cells that it needs to be entered in. The only way I have been able to make it work is when the sheet is not protected and the user can select the cell where the timestamp needs to be entered, but in doing this the user can still delete the entry.

Does anyone know how I can get this to work?

 

[mumps]

This will place the computer name in cell F1. Change the cell in the code to suit your needs.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("B:E")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect Password:="password"
    Target = Format(Now, "hh:mm:ss AM/PM")
    Target.Locked = True
    Range("F1") = Environ$("computername")
    ActiveSheet.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 

[sm8392]

You are truly amazing!

This works perfectly! Is there a way to record the computer name each time a timestamp is recorded, and maybe have it record to a separate sheet?

 

[mumps]

This version will add the computer name to "Sheet2" in column A each time a timestamp is recorded. After a while this list will become rather long and you may have to clear it unless you decide to record the computer name in some other fashion.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("B:E")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect Password:="password"
    Target = Format(Now, "hh:mm:ss AM/PM")
    Target.Locked = True
    Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1, 0) = Environ$("computername")
    ActiveSheet.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 

[sm8392]

This is fantastic! Thank you!

Is there a way to have it record from Columns B thru E? Similar to that of the timestamp? And can we lock these as well so they cannot be edited?

 

[mumps]

See if this does what you want.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("B:E")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="password"
    Sheets("Sheet2").Unprotect Password:="password"
    Target = Format(Now, "hh:mm:ss AM/PM")
    Target.Locked = True
    Range("A" & Target.Row & ":E" & Target.Row).Copy Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1, 0)
    Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "F").End(xlUp).Offset(1, 0) = Environ$("computername")
    With Sheets("Sheet2")
        .Columns.AutoFit
        .Cells.Locked = True
    End With
    ActiveSheet.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    Sheets("Sheet2").Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Sheet2").EnableSelection = xlUnlockedCells
    Application.ScreenUpdating = True
End Sub

 

[sm8392]

That works, but it's not quite what I'm looking for.

Is it possible to do something like this for sheet 2 (it doesn't need to add the date or the timestamp on the second table, just the computer name):

June 8th	WS-PA-SM-11	WS-PA-SM-11	WS-PA-SM-11	WS-PA-SM-11
June 9th	WS-PA-SM-11	WS-PA-SA-11

<tbody>
</tbody>

 

[mumps]

This looks like you want to copy the date from column A of Sheet1 and then have the computer name added to the right of the date when you double click the cell. Is this correct?

 

[sm8392]

Yes, when the user double clicks to record their timestamp for the day, I want it to also record the computer name in Sheet 2 but in a similar table to that of Sheet 1 to make it easier to keep track of what computer is being used to record the timestamp.

Sheet 1:

June 8th	8:30:25 AM	12:31:04 PM	1:32:35 PM	5:29:14 PM
June 9th

<tbody>
</tbody>

Sheet 2:

June 8th	WS-PA-SM-11	WS-PA-AP-11	WS-PA-SM-11	WS-PA-SM-11
June 9th

<tbody>
</tbody>

 

[mumps]

Start by unlocking columns A to E in Sheet1. Format column A in Sheet1 and Sheet2 as "Date". Protect both sheets with "password". Copy/paste the 2 macros below into the Sheet1 code module. Enter a date in column A of Sheet1 and exit the cell. This date will be automatically copied to column A of Sheet2. Double click any of the time stamp cells in Sheet1.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("B:E")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim lColumn As Long
    Dim strdate As String
    strdate = Range("A" & Target.Row).Value
    Dim foundDate As Range
    ActiveSheet.Unprotect Password:="password"
    Sheets("Sheet2").Unprotect Password:="password"
    Target = Format(Now, "hh:mm:ss AM/PM")
    Target.Locked = True
    Set foundDate = Sheets("Sheet2").Range("A:A").Find(CDate(strdate), LookIn:=xlFormulas, lookat:=xlWhole)
    If Not foundDate Is Nothing Then
        lColumn = Sheets("Sheet2").Cells(foundDate.Row, Columns.Count).End(xlToLeft).Column + 1
        Sheets("Sheet2").Cells(foundDate.Row, lColumn) = Environ$("computername")
    End If
    With Sheets("Sheet2")
        .Columns.AutoFit
        .Cells.Locked = True
    End With
    ActiveSheet.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    Sheets("Sheet2").Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Sheet2").EnableSelection = xlUnlockedCells
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Sheets("Sheet2").Unprotect Password:="password"
    Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1, 0) = Target
    Sheets("Sheet2").Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Sheet2").EnableSelection = xlUnlockedCells
    Application.ScreenUpdating = True
End Sub

 

[sm8392]

This is excellent! Thank you so much!!!