Double click only Time

[DBarley17022]

I have a sign in/out sheet That Columns D2:2000, E2:2000 once double clicked enter current time. what I need is that It can be only double click. and not manually entered. I already have the VBA code that enters current time on double click.
Current codes are;
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("A2:A2000")) Is Nothing Then
Target.Value = Date
Cancel = True
ElseIf Not Intersect(Target, Range("D2:D2000,E2:E2000")) Is Nothing Then
Target.Value = Time
Cancel = True
End If
End Sub

any suggestion would be helpful.

 

[Yongle]

The date could be auto-entered when cell is clicked using Worksheet_SelectionChange with a line to auto-activate a different cell (this preventing user from entering anything manually in the cell)
Double-click event on same cells could be password protected to allow cell edit where required

 

[DBarley17022]

The date could be auto-entered when cell is clicked using Worksheet_SelectionChange with a line to auto-activate a different cell (this preventing user from entering anything manually in the cell)
Double-click event on same cells could be password protected to allow cell edit where required

I'm not worried about the date. I have a select few kids that thinks it funny to put in what ever time they wish. The time being accurate is the most important part, It's for their own protection.

 

[ZVI]

Hi and welcome to the MrExcel board!
Try this:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Application.EnableEvents = False
  If Not Intersect(Target, Range("A2:A2000")) Is Nothing Then
    Target.Value = Date
    Cancel = True
  ElseIf Not Intersect(Target, Range("D2:E2000")) Is Nothing Then
    Target.Value = Time
    Cancel = True
  End If
  Application.EnableEvents = True
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rng As Range, v
  Set Rng = Intersect(Target, Range("A2:A2000,D2:E2000"))
  If Rng Is Nothing Then Exit Sub
  For Each v In Rng
    If v <> Empty Then  ' <-- Allow cell cleaning
      Application.EnableEvents = False
      Target.Select
      MsgBox "Use double click to enter date-time into columns A,D,E", vbExclamation, "Not allowed"
      Application.Undo
      Application.EnableEvents = True
      Exit For
    End If
  Next
End Sub

Regards

 

[DBarley17022]

I had to make a slight correction! But now I have what I need. Thank You ZVI.

 

[ZVI]

I had to make a slight correction! But now I have what I need. Thank You ZVI.

Glad you got a template for solution!

 

[DBarley17022]

I currently don't know how to write VBA, which is why I joined here! But seriously I should take some classes on this!