Solved: enter current time in a current cell

[miatch]

I'm trying to minimize the effort to input data in a sheet I've built for recording time for dispatched workers I need to find a way to fill a cell with the current time by just clicking or double clicking on it. The idea being that a technician can see the details of a work order, then just double click on the appropriate cell to record their dispatch time.

This is my code,but something is wrong. can somebody please help me.


Public Sub Tester()

Dim wks As Worksheet
Dim MyRange As Range
Dim IntersectRange As Range

Set MyRange = Range("A9:A39")
Set IntersectRange = Intersect(Target, MyRange)

On Error GoTo SkipIt
If IntersectRange Is Nothing Then
Exit Sub

Else

ActiveSheet.Unprotect
Application.ScreenUpdating = False
Target = Format(Now, "ttttt")
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xllockedCells

End If

ActiveSheet.Unprotect
Rows("1:3").Select
Range("1:3,A4:E65536").Select
Range("1:3,A4:E65536,G4:IV65536").Select
Selection.Locked = False
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
ActiveCell.Offset(, 1).Select
SkipIt:
Exit Sub
End Sub

[Bob Phillips]

This code looks as though it is part of something bigger. You refer to target but nowhere is it defined. I would have expected to see a selection or doubleclick worksheet event there to achieve your objective.

[miatch]

if I write

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

insted of public sub tester() then it runs for each sheet, but I have 100 Sheets, and would like the code to run on all of them.

[Bob Phillips]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const WS_RANGE As String = "A9:A39" '<== change to suit

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

With Target

Me.Unprotect
Target.Value = Format(Now, "ddddd")
Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Me.EnableSelection = xllockedCells
Cancel = True
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

[miatch]

thanks! But How can I make this code run for all 100 sheets, it does not work when I put it in module (2).

[Bob Phillips]

In ThisWorkbook




Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Const WS_RANGE As String = "A9:A39" '<== change to suit

On Error Goto ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Sh.Range(WS_RANGE)) Is Nothing Then

With Target

Sh.Unprotect
Target.Value = Format(Now, "ddddd")
Sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sh.EnableSelection = xllockedCells
Cancel = True
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

[miatch]

thanks :) is it posible to get the time as vel in (d9:d39), in the same code?

[Bob Phillips]

D9:D39 as well as A9:A39, or instead of?

[miatch]

as well, A9:A39(date) and D9:E39(time).

[mdmackillop]

Target.Value = Format(Now, "ddddd")
Target.Offset(, 3).Value = Format(Now, "hh:mm")

[miatch]

Im not shore where you want me to put those lines? I can make the date run, but not the time.

[mdmackillop]

The first line already appears in the code (Post #6), the second line is the new line which will follow it.

[miatch]

I think you misunderstood me. I want to get the current time by clicking on the time-cell (d9:e38), and current date by clicking og the date-cells (a9:a38). Not getting the time by clicking on the date-cells.

[mdmackillop]

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Const WS_RANGE As String = "A9:A39, D9:E39" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Sh.Range(WS_RANGE)) Is Nothing Then
With Target
Sh.Unprotect
Select Case Target.Column
Case 1
Target.Value = Format(Now, "ddddd")
Case Else
Target.Value = Format(Now, "hh:mm")
End Select
Sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sh.EnableSelection = xllockedCells
Cancel = True
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

[miatch]

that works really well. thanks again :D