Timer In Status Bar

[Dazzawm]

Is there anyway that a timer can be put in a workbook and counts up every time its opened? When I start a new project I want to see how long it takes, so from the moment I start it I want it to count up and then stop when I close it. Then when I open it again the next day I want it to continue from where it left of and so on. Possible? Thanks.

 

[Warship]

Use a Defined Name to hold your Total Time.
Add each sessions total time to the name upon close.

 

[Dazzawm]

Thats gone right over my head!

 

[Warship]

I think this is working up to 24 hours.
However it will not keep track after 24 hrs Total Time.
Using format "[h]:mm" doesn't work.
Can anyone fix it to track beyond 24 hrs?

Private Sub Workbook_Open()
    ProjectTimeSetup
    ThisWorkbook.Names("StartTime").RefersTo = Now
    UpdateProjTime
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    UpdateProjTime
    ThisWorkbook.Names("TotalTime").RefersTo = TotalTime + SessionTime
End Sub

Dim StartTime
Dim EndTime
Public SessionTime
Public TotalTime
Const updateSecs = 60 'interval of seconds to update status bar

Sub UpdateProjTime()
    StartTime = Evaluate("StartTime")
    TotalTime = Evaluate("TotalTime")
    EndTime = Now
    SessionTime = EndTime - StartTime
    Application.StatusBar = "Session Time: " & Format(SessionTime, "h:mm") _
             & " | Total Time: " & Format(TotalTime + SessionTime, "h:mm")
    TimerStart
End Sub

Sub ProjectTimeSetup()
    Dim arr As Variant, n As Variant
    arr = Array("StartTime", "TotalTime")
    For Each n In arr
    If IsError(Evaluate(n)) Then _
        ThisWorkbook.Names.Add Name:=n, RefersTo:=0
    Next n
End Sub

Sub TimerStart()
    Application.OnTime _
        EarliestTime:=Now + TimeSerial(0, 0, updateSecs), _
        Procedure:="UpdateProjTime"
End Sub

 

[Dazzawm]

I think this is working up to 24 hours.
However it will not keep track after 24 hrs Total Time.
Using format "[h]:mm" doesn't work.
Can anyone fix it to track beyond 24 hrs?

Private Sub Workbook_Open()
    ProjectTimeSetup
    ThisWorkbook.Names("StartTime").RefersTo = Now
    UpdateProjTime
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    UpdateProjTime
    ThisWorkbook.Names("TotalTime").RefersTo = TotalTime + SessionTime
End Sub

Dim StartTime
Dim EndTime
Public SessionTime
Public TotalTime
Const updateSecs = 60 'interval of seconds to update status bar
 
Sub UpdateProjTime()
    StartTime = Evaluate("StartTime")
    TotalTime = Evaluate("TotalTime")
    EndTime = Now
    SessionTime = EndTime - StartTime
    Application.StatusBar = "Session Time: " & Format(SessionTime, "h:mm") _
             & " | Total Time: " & Format(TotalTime + SessionTime, "h:mm")
    TimerStart
End Sub
 
Sub ProjectTimeSetup()
    Dim arr As Variant, n As Variant
    arr = Array("StartTime", "TotalTime")
    For Each n In arr
    If IsError(Evaluate(n)) Then _
        ThisWorkbook.Names.Add Name:=n, RefersTo:=0
    Next n
End Sub
 
Sub TimerStart()
    Application.OnTime _
        EarliestTime:=Now + TimeSerial(0, 0, updateSecs), _
        Procedure:="UpdateProjTime"
End Sub

^

 

[Warship]

24+ fixed...doh!

Option Explicit
Dim StartTime
Dim EndTime
Public SessionTime
Public TotalTime
Const updateSecs = 60 'interval of seconds to update status bar

Sub UpdateProjTime()
    StartTime = Evaluate("StartTime")
    TotalTime = Evaluate("TotalTime")
    EndTime = Now
    SessionTime = EndTime - StartTime
    Application.StatusBar = "Session Time: " & Application.WorksheetFunction.Text(SessionTime, "[h]:mm") _
             & " | Total Time: " & Application.WorksheetFunction.Text(TotalTime + SessionTime, "[h]:mm")
    TimerStart
End Sub

Sub ProjectTimeSetup()
    Dim arr As Variant, n As Variant
    arr = Array("StartTime", "TotalTime")
    For Each n In arr
    If IsError(Evaluate(n)) Then _
        ThisWorkbook.Names.Add Name:=n, RefersTo:=0
    Next n
End Sub

Sub TimerStart()
    Application.OnTime _
        EarliestTime:=Now + TimeSerial(0, 0, updateSecs), _
        Procedure:="UpdateProjTime"
End Sub

Private Sub Workbook_Open()
    ProjectTimeSetup
    ThisWorkbook.Names("StartTime").RefersTo = Now
    UpdateProjTime
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    UpdateProjTime
    ThisWorkbook.Names("TotalTime").RefersTo = TotalTime + SessionTime
End Sub

 

[Dazzawm]

There seems to be 3 codes here. Do I have to run them all manually or does it do it all automatically?

 

[Warship]

You will need this code in any WB you track.
It runs on it's own each time you open the book
Go to : http://www.contextures.com/xlvba01.html
for help on installing


This goes in a Regular Module

Option Explicit
Dim StartTime
Dim EndTime
Public SessionTime
Public TotalTime
Const updateSecs = 60 'interval of seconds to update status bar

Sub UpdateProjTime()
    StartTime = Evaluate("StartTime")
    TotalTime = Evaluate("TotalTime")
    EndTime = Now
    SessionTime = EndTime - StartTime
    Application.StatusBar = "Session Time: " & Application.WorksheetFunction.Text(SessionTime, "[h]:mm") _
             & " | Total Time: " & Application.WorksheetFunction.Text(TotalTime + SessionTime, "[h]:mm")
    TimerStart
End Sub

Sub ProjectTimeSetup()
    Dim arr As Variant, n As Variant
    arr = Array("StartTime", "TotalTime")
    For Each n In arr
    If IsError(Evaluate(n)) Then _
        ThisWorkbook.Names.Add Name:=n, RefersTo:=0
    Next n
End Sub

Sub TimerStart()
    Application.OnTime _
        EarliestTime:=Now + TimeSerial(0, 0, updateSecs), _
        Procedure:="UpdateProjTime"
End Sub

This goes in the Workbook Module

Private Sub Workbook_Open()
    ProjectTimeSetup
    ThisWorkbook.Names("StartTime").RefersTo = Now
    UpdateProjTime
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    UpdateProjTime
    ThisWorkbook.Names("TotalTime").RefersTo = TotalTime + SessionTime
End Sub

 

[Dazzawm]

Done as you said but it come up with an error and when I selected debug I think it pointed to

SessionTime = EndTime - StartTime

 

[Dazzawm]

This must be a hard request, as loads have viewed the thread but little replies!