Break tracker insert current time after double click on cell

[Abhijeet]

Hi

I want to create Break tracker after double click on particular range double click then insert current time & lock that cells no need to input apart from double click insert any value

Not able to edit that cell after insert time please tell me how to do this

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
Dim rng As Range
Set rng = Range("TimeEntry")

If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, rng) Is Nothing Then
    Application.EnableEvents = False
    Cancel = True 'stop the edit mode
  With Target
        If .Value = "" Then
            .Value = Time
            .Offset(0, 1).Activate
        End If
    End With
End If
Application.EnableEvents = True

End Sub

 

[Chihiro]

Code looks fine. But you don't have "TimeEntry" defined as Named Range in your Workbook.

Either define it or change below line...

Set rng = Range("TimeEntry")

To...

Set rng = UNION(Range("F4:G65"),Range("J4:K65"),Range("N4:O65"))

Edit: To lock the cell, just use sheet protection with cell originally set to Unlocked and then lock it after value changes from blank.

 

[Abhijeet]

Edit: To lock the cell, just use sheet protection with cell originally set to Unlocked and then lock it after value changes from blank.

In this case before enter anything user can insert manually time i want to restrict that as well only double click will work in those cells

 

[Chihiro]

Then just unprotect sheet when condition is met and update info then protect it.

 

[Abhijeet]

I tried this but unable to do this can u pls give me macro on this

 

[Chihiro]

First protect your sheet.

Use code below and change password as needed.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
Dim rng As Range
Set rng = Union(Range("F4:G65"), Range("J4:K65"), Range("N4:O65"))

If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, rng) Is Nothing Then
    Application.EnableEvents = False
    Cancel = True 'stop the edit mode
With Target
        If .Value = "" Then
            ActiveSheet.Unprotect "Your Password"
            .Value = Time
            .Offset(0, 1).Activate
            ActiveSheet.Protect "Your Password"
        End If
    End With
End If
Application.EnableEvents = True

End Sub

 

[Abhijeet]

Thanks for this