Need idle message to pop-up w/o closing file and to stop when file is closed

[BonnieM]

Looking for message to pop-up when sheet is idle, and not automatically close file, nor continue to run after file is closed. This is my current code which pops up whether idle or not:

This Workbook
Private Sub Workbook_Open()
Application.Run "StartTimer"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Run "StopTimer"
End Sub


Module 1
Public RunWhen As Double
Public Const cRunIntervalSeconds = 300 ' 5 minutes
Public Const cRunWhat = "CloseMacro" ' the name of the procedure to run


Module 2
Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=True
End Sub
Sub CloseMacro()
Application.DisplayAlerts = False
'ThisWorkbook.Save
'ThisWorkbook.Close
'Application.Quit
MsgBox ("This File Has Been Idle for 5 Minutes" & vbCr & "Please Save and Close Now")
StartTimer ' Reschedule the procedure
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=False
End Sub

 

[AlphaFrog]

This link may help. It uses the Workbook_SheetChange and Workbook_SheetSelectionChange event procedures to reset the idle msgbox

Timed Closing Of A Workbook

 

[BonnieM]

Thanks, I've seen this, but I do not want to close the workbook and I want the message to repeat if the user does not save and close (to be an annoyance until they do). I have tried adjusting this code but have not been able to achieve desired result.

 

[AlphaFrog]

Thanks, I've seen this, but I do not want to close the workbook and I want the message to repeat if the user does not save and close (to be an annoyance until they do). I have tried adjusting this code but have not been able to achieve desired result.

Use the code in the link with these changes

[COLOR=darkblue]Public[/COLOR] RunWhen [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Double[/COLOR]
[COLOR=darkblue]Public[/COLOR] [COLOR=darkblue]Const[/COLOR] NUM_MINUTES = [COLOR=#ff0000]5[/COLOR]
    
[COLOR=darkblue]Public[/COLOR] [COLOR=darkblue]Sub[/COLOR] SaveAndClose()
[COLOR=#ff0000]    MsgBox "This File Has Been Idle for 5 Minutes" & vbCr & "Please Save and Close Now"
    
    [COLOR=green]'Reset next idle message[/COLOR]
    RunWhen = Now + TimeSerial(0, NUM_MINUTES, 0)
    Application.OnTime RunWhen, "SaveAndClose", , True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[BonnieM]

Thanks for your suggestion. I had already tried this, but after the user closes the workbook, the code continues to run, causing the file to reopen and the msgbox to pop up. Hence my question above. I appreciate the help and am open to suggestions . . .

 

[AlphaFrog]

Thanks for your suggestion. I had already tried this, but after the user closes the workbook, the code continues to run, causing the file to reopen and the msgbox to pop up. Hence my question above. I appreciate the help and am open to suggestions . . .

Did you put this in the ThisWorkbook code module. The bolded part should prevent it from showing the message when it closes. If you changed the name of the message macro from SaveAndClose, then all the code needs to reflect the different macro name.

I've tested this code and it seems to work for me.

Private Sub Workbook_Open()
    On Error Resume Next
    Application.OnTime RunWhen, "SaveAndClose", , False
    On Error GoTo 0
    RunWhen = Now + TimeSerial(0, NUM_MINUTES, 0)
    Application.OnTime RunWhen, "SaveAndClose", , True
End Sub
[B]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Application.OnTime RunWhen, "SaveAndClose", , False
    On Error GoTo 0
End Sub[/B]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    Application.OnTime RunWhen, "SaveAndClose", , False
    On Error GoTo 0
    RunWhen = Now + TimeSerial(0, NUM_MINUTES, 0)
    Application.OnTime RunWhen, "SaveAndClose", , True
End Sub

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

    On Error Resume Next
    Application.OnTime RunWhen, "SaveAndClose", , False
    On Error GoTo 0
    RunWhen = Now + TimeSerial(0, NUM_MINUTES, 0)
    Application.OnTime RunWhen, "SaveAndClose", , True

End Sub

 

[BonnieM]

Well, I copied and pasted it again, and it appears to be working. Not sure what I had done differently - but bottom line is, you helped to solve an issue I've been struggling with for a week! Thanks!

 

[AlphaFrog]

You're welcome. Thanks for the feedback.