Timer + Stop Watch

[Svmaxcel]

I have a code to close workbook automatically after 30 min so that, if others has kept the file open others won't be able to use it.
Below is the code.
Module 1

Option Explicit

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:30:00")  ''<--- change time to close here
   Application.OnTime EarliestTime:=DownTime, Procedure:="ShutDown", Schedule:=True
End Sub
Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=False
 End Sub
Sub ShutDown()

    Application.DisplayAlerts = False
    With ThisWorkbook
        .Saved = True
        .Close
    End With
   
End Sub

Added below code in Thisworksheet.

Option Explicit

Private Sub Workbook_Open()
    Call SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
    Application.DisplayAlerts = False
    ThisWorkbook.Saved = True
    Application.Visible = False
    Application.Quit
End Sub

I want that all changes should be saved in a file,

To track changes in the workbook, paste this code into ThisWorkbook module :

Option Explicit
Dim vOldVal 'Must be at top of module

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim strUserName As String
Dim xFormula As Boolean
Dim xDate As Boolean
Dim xHead As Range
Dim xTitle As Range
Dim n As Integer

Set xHead = Sheets("Track_Changes").Range("B3:H3")
strUserName = Application.UserName

On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
  
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
  
    If IsEmpty(vOldVal) Then vOldVal = "[empty cell]"
    xFormula = Target.HasFormula
    xDate = IsDate(Target)

    With Sheets("Track_Changes")
        .Unprotect Password:="Password"
    
                If .Range("B2") = vbNullString Then
                    xHead = Array("DATE OF CHANGE", "TIME OF CHANGE", "SHEET NAME", "CELL CHANGED", "CHANGE BY", "OLD VALUE", "NEW VALUE")
                Sheets("Track_Changes").Columns(1).ColumnWidth = 3
              
                .Range("B1").Value = "Track Changes"
                .Range("B1").Font.Size = 18
                              
                With xHead
                    .Interior.Color = RGB(30, 139, 195)
                    .Font.Color = vbWhite
                    .Font.Bold = True
                End With

                With xHead.Borders(xlInsideVertical)
                    .Color = vbWhite
                    .Weight = xlMedium
                End With
                End If
          
      
        With .Cells(.Rows.Count, 2).End(xlUp)(2, 1)
                    .Borders(xlInsideVertical).Color = RGB(255, 191, 191)
                    .Borders(xlInsideVertical).Weight = xlMedium
                  
                    .Value = Date
                    .Offset(0, 1) = Format(Now, "hh:mm:ss")
                    .Offset(0, 2) = Target.Parent.Name
                    .Offset(0, 3) = Target.Address
                    .Offset(0, 4) = strUserName
                    .Offset(0, 5) = vOldVal
                
                    With .Offset(0, 6)
                        If xFormula = True Then
                            .ClearComments
                            .AddComment.Text Text:="Cell is bold as value contains a formula"
                        End If
                        If xDate = True Then
                            .NumberFormat = "dd/mm/yyyy"
                        End If
                        .Value = Target
                        .Font.Bold = xFormula
                        If IsEmpty(Target) Then .Value = "[empty cell]"
                    End With
                  
            End With

            .Cells.Columns.AutoFit
            .Cells.Columns.HorizontalAlignment = xlLeft
          
n = Sheets("Track_Changes").Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count - 1
With Sheets("Track_Changes").Range("B4:H" & n + 2)
        .Borders(xlInsideHorizontal).Color = RGB(30, 139, 195)
        .Borders(xlInsideHorizontal).Weight = xlThin
        .Borders(xlInsideVertical).Color = RGB(200, 200, 200)
        .Borders(xlInsideVertical).Weight = xlThin
End With
.Protect Password:="Password"
        End With
    vOldVal = vbNullString

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

On Error GoTo 0

End Sub



Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

On Error Resume Next
If Selection.Cells.Count > 1 Then Exit Sub 'Avoid runtime error 7
   vOldVal = Target

End Sub

My issue is that a user will not come to know when he had opened the file and when it will close.
So I want a timer displaying the minutes left, a normal pop up will also do, to alert the user.
Also if possible, can we add a extend option to extend the period.

[offthelip]

try this:

Sub SetTimer()
    DownTime = Now + TimeValue("00:05:00") ''<--- change time to close here
    Application.OnTime EarliestTime:=DownTime, Procedure:="ShutDown", Schedule:=True
End Sub




Sub Setwarning()
    DownTime = Now + TimeValue("00:25:00") ''<--- change time to close here
    Application.OnTime EarliestTime:=DownTime, Procedure:="Warning", Schedule:=True
End Sub
Sub Setwarning5()
    DownTime = Now + TimeValue("00:05:00") ''<--- change time to close here
    Application.OnTime EarliestTime:=DownTime, Procedure:="Warning", Schedule:=True
End Sub


Sub warning()
 ext = MsgBox("You only have 5 minutes left to use this file, do you want to extend by 5 minutes?", vbYesNo)
  If ext = vbYes Then
   Call Setwarning5
  Else
   Call SetTimer
  End If
  
  
End Sub


Private Sub Workbook_Open()
    Call Setwarning
End Sub

note: not tested

[Svmaxcel]

Hi
Where should input the code.
I mean is it in Thisworksheet, new modules?

[offthelip]

The private sub workbook_open has to go in "This Workbook" which presumably is where you had it anyway, I just changed the subroutine it was calling

the setwarning and setwarning5 subroutines can go where you had the setTimer routine which I presume was in module 1, since you wrote module 1 at the top. but it isn't critical you can put them more or less anywhere.