lojanica
New Member
- Joined
- Feb 22, 2024
- Messages
- 34
- Office Version
- 365
- Platform
- Windows
Hi All,
I have found a post from back in 2020 which shows some examples of how to do this and the new Excel document works perfectly
Here is the code for the Module1.
Here is the code under ThisWorkbook:
As mentioned, codes work perfectly on new documents.
However, I would like to implement it in the document, which already has code under ThisWorkbook.
Please see the below code under ThisWorkbook in my document.
As you can see, I have moved "Call SetTimer" to the existing Private Sub Workbook_Open().
The problem is that when the timer is up, the document closes and opens again with a message from the attached photo.
If I press Enable Macro, it goes in a loop, opening and closing the document.
If I press disable Macro, an error message appears. When I press okay, it pops up again and again.
My existing code is affecting it, but I cannot see what is causing these issues.
Any Suggestions?
I have found a post from back in 2020 which shows some examples of how to do this and the new Excel document works perfectly
VBA to autosave and close after a set amount of time
We have the same problem at work as I'm sure many others have had. Someone opens the shared spreadsheet file, then jumps on a conference call, leaves the office, and forgot they left it open. Several hours pass and nobody is able to do any work in the file. I asked our girl in IT about this...
www.mrexcel.com
Here is the code for the Module1.
VBA Code:
Dim DownTime As Date
Sub SetTimer()
DownTime = Now + TimeValue("00:01:00")
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
ThisWorkbook.Close SaveChanges:=True
End Sub
Here is the code under ThisWorkbook:
VBA Code:
Private Sub Workbook_Open()
Call SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopTimer
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call StopTimer
Call SetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Excel.Range)
Call StopTimer
Call SetTimer
End Sub
As mentioned, codes work perfectly on new documents.
However, I would like to implement it in the document, which already has code under ThisWorkbook.
Please see the below code under ThisWorkbook in my document.
VBA Code:
Private Sub Workbook_Open()
ThisWorkbook.Sheets("AMSI-R-102 Job Request Register").Range("B6").Value = Environ("USERNAME")
Call SetTimer
Dim mainwb As Workbook
Dim usernameSheetName As String
Dim targetSheet As Worksheet
Set mainwb = ActiveWorkbook
usernameSheetName = mainwb.Sheets("AMSI-R-102 Job Request Register").Range("B6").Value
On Error Resume Next
Set targetSheet = mainwb.Sheets(usernameSheetName)
On Error GoTo 0
If Not targetSheet Is Nothing Then
targetSheet.Activate
Else
mainwb.Sheets("AMSI-R-102 Job Request Register").Activate
Exit Sub
End If
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
Range("A6:I6").AutoFilter Field:=8, Criteria1:=Range("B6")
Range("A6:I6").AutoFilter Field:=7, Criteria1:="In progress"
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A8:I" & lastRow).Sort Key1:=Range("D8:D" & lastRow), Order1:=xlAscending, Header:=xlNo
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopTimer
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call StopTimer
Call SetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Excel.Range)
Call StopTimer
Call SetTimer
End Sub
As you can see, I have moved "Call SetTimer" to the existing Private Sub Workbook_Open().
The problem is that when the timer is up, the document closes and opens again with a message from the attached photo.
If I press Enable Macro, it goes in a loop, opening and closing the document.
If I press disable Macro, an error message appears. When I press okay, it pops up again and again.
My existing code is affecting it, but I cannot see what is causing these issues.
Any Suggestions?