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.


[VBA]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[/VBA]

[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]

[vba]

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
[/vba]

[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

[vba]


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
[/vba]

[miatch]

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

[Bob Phillips]

D939 as well as A9:A39, or instead of?

[miatch]

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

[mdmackillop]

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

[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]

[VBA]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[/VBA]

[miatch]

that works really well. thanks again