Stop watch timer to capture accurate time of task completion

[aliaslamy2k]

I am looking for a VBA to know the accurate time taken to complete each task.

1.Column A 4– Contains Task Start date

2. From column B4 to K100 I will have data in each row

3. In Column L4 to L100 I need a stop watch timer to count the time and days taken to complete the tast (NOTE: Timer starts only when task date is entered in any column between A4 to A100)

4. If all columns are filled with data from in each row (i.e A4:K4) then I need a comment in M4 as “ Task Completed” and timer should stop. (Same should continue in all rows whenever task date is entered in Column A)

5. Once the time is captured, I want to protect the Task start date and timer cell to avoid manipulating by user. ( I should be able to enter my own password to unprotect).

I hope this is possible with excel VBA

Thank you

 

[aliaslamy2k]

Hello,

Is this possible with Excel ?

 

[John_w]

This can be done with the Worksheet_Change event handler for the sheet in question, e.g. "Sheet1".

Stopwatch timers aren't needed because the Worksheet_Change code appends the current time to the date entered by the user in A4:A100. With both the date and time, the code can calculate an accurate elapsed time in days, hours and minutes. You can format A4:A100 so that only the date is displayed or both the date and time are displayed.

Put this code in the ThisWorkbook module:

Option Explicit

Private Sub Workbook_Open()
    Worksheets("Sheet1").Protect Password:=ProtectSheetPassword, UserInterfaceOnly:=True
End Sub

Put this code in the Sheet1 module:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim AKcells As Range
    Dim DiffTime As Date

    If Not Intersect(Target, Range("A4:K100")) Is Nothing And Target.Cells.Count = 1 Then
    
        Application.EnableEvents = False
        
        If Target.Column = 1 Then
        
            'Append current time to date entered in column A cell
            
            If IsDate(Target.Value) Then
                Target.Value = Target.Value + Time
            End If
            
        Else
        
            Set AKcells = Range(Cells(Target.Row, "A"), Cells(Target.Row, "K"))
            
            'If all cells in columns A:K in the row are populated, put calculated Task Completion Time in L cell and "Task Completed" in M cell and lock A and L cells
            
            If WorksheetFunction.CountA(AKcells) = AKcells.Count Then
    
                DiffTime = Now - Cells(Target.Row, "A").Value                
                Cells(Target.Row, "L").Value = CLng(Int(DiffTime)) & " days " & Format(Hour(DiffTime), "00") & " hours " & Format(Minute(DiffTime), "00") & " mins"               
                Cells(Target.Row, "M").Value = "Task Completed"                
                Cells(Target.Row, "A").Locked = True
                Cells(Target.Row, "L").Locked = True
                Protect Password:=ProtectSheetPassword, UserInterfaceOnly:=True

            End If
        
        End If
        
        Application.EnableEvents = True
        
    End If
    
End Sub

Put this code in a standard module, e.g. Module1:

Public Const ProtectSheetPassword As String = "xyz"

'Run this first to set all cells on active sheet to not locked

Public Sub Unlock_All_Cells()
    ActiveSheet.Cells.Locked = False
End Sub

You will see that the password to protect the sheet is "xyz". Change this as required.

Run the Unlock_All_Cells macro on the active sheet, then save, close and reopen the macro workbook.

 

[aliaslamy2k]

Hi John_w,

Thanks a million, this working excellent for me