Session Times

[will07]

Hello All,

Is it possible to add some code into a file that will show the session time
(in a cell)that a file is open or has been used.

thanks

 

[Geoff K]

try something like this

put this into your ThisWorkBook module
Private Sub Workbook_Open()
With Sheets(1)
.Range("A1") = "Wbook opened at:"
.Range("A2") = Format(Now, "dd/mm/yyyy hh:mm:ss")
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Sheets(1)
.Range("B1") = "Last closed at:"
.Range("B2") = Format(Now, "dd/mm/yyyy hh:mm:ss")
End With
End Sub

hth

Geoff K

 

[Gary''s Student]

Private Sub Workbook_Open()
Sheets("Sheet1").Range("A1").Formula = "=now()"
Sheets("Sheet1").Range("A2").Value = Now
Sheets("Sheet1").Range("A3").Formula = "=a1-a2"
Sheets("Sheet1").Range("A3").NumberFormat = "h:mm:ss;@"
End Sub

Whenever the worksheet is calculated, A3 will display the session time.

 

[Tom Ogilvy]

Just a thought, but wouldn't the workbook need to be saved to retain the
values?

 

[Geoff K]

That's true and on reflectiion I think my interpretation of "has been used"
is not what the op was wanting. Gary's solution is of course on the mark for
the current session which is most probably what was required though it does
not provide for history.

Geoff K

 

[Geoff K]

Another solution as it fits your criteria (in a cell) can be found here with
Bob Philip's respons
http://www.microsoft.com/communitie...c6b9&mid=b0c6f8db-faa1-47f6-bc16-35646daae260

hth

Geoff K

 

[will07]

Geoff,

The code worked OK, however both times are current (the same). I was
thinking after I wrote in, it would be great to have a ticking clock in range
B1:B2 to let the user know how long the session is taking. The range A1:A2
(start of session) works great. I need to get the user thinking how long
he/she is spending on 1 job.

The history does not matter, and the session time need not be archived,
although it would help.

Thanks

 

[Geoff K]

Hi will07
I have combined both solutions here but as the Ticking Clock calculates the
wsheet each second to show the elapsed time it can have a great impact upon
other calculations which your wsheet may need to perform. This means it may
be appreciably slower to run.
Because the Ticking Clock is included here, you will notice a side effect is
it will also change the calculation for Current Time and Elapsed in B2 and C2.
For me, I would not include the Ticking Clock as it will have an impact on
the rest of the wsheet calculation but by how much will depend on what you
are doing.
Without the Ticking Clock B2 and C2 will not change until the wsheet
performs a calculation which can be as a result of your formulae or F9.
If you do not want the Ticking Clock then remove by following the comments.

hth

Geoff K

To adapt the previous solutions:

Put this in the ThisWorkbook module

Private Sub Workbook_Open()
With Sheets(1)
.Range("A1") = "Commenced"
.Range("B1") = "Current Time"
.Range("C1") = "Elapsed"
.Range("A2").NumberFormat = "dd/mm/yyyy hh:mm:ss;@"
.Range("B2").NumberFormat = "dd/mm/yyyy hh:mm:ss;@"
.Range("C2").NumberFormat = "hh:mm:ss;@"
.Range("B2").Formula = "=now()"
.Range("A2").Value = Now
.Range("C2").Formula = "=B2-A2"
End With
StartTickingClock '''<<<Remove if not required
End Sub

'''<<<Remove if not required
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTickingClock
End Sub

************************************
Put this in a standard module (In the VBE Project Explorer click on Insert
Module)

Option Explicit

'''If Project Explorer is not revealed then from Menu goto View > Project
Explorer -
'''You will now see VBAProject(Ticking Clock.xls)
'''If there is a "+" against Modules then click to expand -
'''Right click on "Module 1" - Select "Remove Module 1" and answer "no" to
export

Public nTime As Double

Public Sub StartTickingClock()
On Error Resume Next
Application.OnTime nTime, "RunTimer", , False
On Error GoTo 0
ActiveSheet.Range("E2").Value = 0
RunTimer
End Sub

Public Sub StopTickingClock()
Application.OnTime nTime, "RunTimer", , False
End Sub

Public Sub RunTimer()
With ActiveSheet
.Range("E1") = "Elapsed"
.Range("E2").Value = .Range("E2").Value + TimeSerial(0, 0, 1)
.Range("E2").NumberFormat = "hh:mm:ss"
End With
nTime = Now + TimeSerial(0, 0, 1)
Application.OnTime nTime, "RunTimer"
End Sub

************************************
Put this in the wsheet 1 code module (Right click Sheet1 tab and select View
Code)

Option Explicit

'''''<<<Remove ALL if not required by selecting the dialog then backspace to
clear
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "1" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value Then
StopTickingClock
StartTickingClock
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

 

[will07]

Geoff,

You are right, having the ticking clock slowed the process down so I will
not have that. I entered your code (with and without the clock) into a
practice workbook and it worked very well and is exactly the type of thing I
need.

The actual file I will use allready has some code in the Workbook_Open()
section, and when I enter your code in the same area it will not work. Can I
enter this code into the worksheet instead of the workbook. or can I change
the heading as I cannot have 2 workbook_open. Thank you very much for your
help so far, it has been invaluable.

 

[Geoff K]

Hi
It is difficult to know what is going on without your code . It would be
best to post your Workbook_Open code rather than me to speculate.

Geoff K

 

[will07]

Geoff,

This is the code that I have placed in the workbook open area. This code
looks for the server 1 and if it does not find it, then the file will not
open. When I place your code under this one, your code does not work.

Any help would be great.

Thanks

Private Sub Workbook_Open()
'Get the Computer Name
Dim sComputer As String
sComputer = VBA.Environ("LOGONSERVER")
result = StrComp(sComputer, "\\SERVER1", vbTextCompare)
If result <> 0 Then
MsgBox "This is not your file.", vbInformation, "Australasian"
ActiveWorkbook.Close False
End If
End Sub

 

[Geoff K]

Copy / paste this to the ThisWorkbook module:

hth

Geoff K

Private Sub Workbook_Open()

'Get the Computer Name
Dim sComputer As String
Dim result As Long

sComputer = VBA.Environ("LOGONSERVER")
result = StrComp(sComputer, "\\SERVER1", vbTextCompare)
If result <> 0 Then
MsgBox "This is not your file.", vbInformation, "Australasian"
ThisWorkbook.Close False
Exit Sub
End If

With Sheets(1)
.Range("A1") = "Commenced"
.Range("B1") = "Current Time"
.Range("C1") = "Elapsed"
.Range("A2").NumberFormat = "dd/mm/yyyy hh:mm:ss;@"
.Range("B2").NumberFormat = "dd/mm/yyyy hh:mm:ss;@"
.Range("C2").NumberFormat = "hh:mm:ss;@"
.Range("B2").Formula = "=now()"
.Range("A2").Value = Now
.Range("C2").Formula = "=B2-A2"
.Columns("A:C").AutoFit
End With

End Sub