Excel VBA Timer Halting Other Code

I have created (oh I mean copied) code to have a timer close my workbook after 3 minutes of inactivity. However, the timer is locking up all the other code I worked so diligently to create (uh....copy). Please take a look. Where am I going wrong? (oh....I'm only like 1-2 weeks into being a VBA user....so be kind)

In "This Workbook"

Private Sub Workbook_Open()
StartTimer
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
StartTimer
End Sub

In "Module x"

Const idleTime = 300 'seconds
Dim Start

Sub StartTimer()
' ===========
' This will make the file close (no save) after the idle time listed above
' ===========
Start = Timer
Do While Timer < Start + idleTime
DoEvents
Loop
Application.DisplayAlerts = False
' *************
' Don't forget to change name of workbook below
' *************
Workbooks("TestArea-Data collection tool.xlsm").Close SaveChanges:=False
End Sub



I don't get an error when this locks up my other code. Everything just kinda stops. And so my impatient self closes and starts over. All my other code is in a userform. I can post that if it's needed. But it works flawlessly until I turn on the timer coding (above) on. THANKS!

I keep losing my replies! I'll fix that seconds thing....we had changed from 5 minutes to 3 and I forgot to update it. Thank you. Should I post my other code to help see where the error is? Thank you

Here is my other code. It's a form. When I try the Submit and Enter Another button (I had to remove code for another button because my reply was too long), it freezes up around the line that I put in red. However, when the timer code isn't "turned on", the form works perfectly.


Private Sub SpinButton3_Change()
Me.TextBox3.Value = Format(Date - SpinButton3.Value, "mm/dd/yyyy")
End Sub


Private Sub SubmitThenAnother_Click()
' ===============
' a variable to hold the nuimber of rows of data on the worksheet...helps figure out the next blank row
' ===============
Dim RowCount As Long
' ================
' Clears the form when hit submit
' ================
Dim ctl As Control
' ================
' Unprotect Data worksheet
' ================
Worksheets("Data").Unprotect Password:="qr!"
' =================
' This code checks to make sure all boxes in the form have data in them
' =================
If Me.SLI.Value = "" Then
MsgBox "Please Select a Service Line", vbExclamation, "Required Data Missing"
Me.SLI.SetFocus
Exit Sub
End If
If Me.UnitI.Value = "" Then
MsgBox "Please Select a Unit", vbExclamation, "Required Data Missing"
Me.UnitI.SetFocus
Exit Sub
End If
If Me.ShiftI.Value = "" Then
MsgBox "Please Select a Shift", vbExclamation, "Required Data Missing"
Me.ShiftI.SetFocus
Exit Sub
End If
If Me.HARI.Value = "" Then
MsgBox "Please Fill in the HAR (no MRN's please)", vbExclamation, "Required Data Missing"
Me.HARI.SetFocus
Exit Sub
End If
If Me.CMI.Value = "" Then
MsgBox "Please Complete Cardiac Monitoring", vbExclamation, "Required Data Missing"
Me.CMI.SetFocus
Exit Sub
End If
If Me.O2I.Value = "" Then
MsgBox "Please Complete Oxygen", vbExclamation, "Required Data Missing"
Me.O2I.SetFocus
Exit Sub
End If
If Me.PulseOxI.Value = "" Then
MsgBox "Please Complete Pulse Ox", vbExclamation, "Required Data Missing"
Me.PulseOxI.SetFocus
Exit Sub
End If
If Me.CardiacStandardI.Value = "" Then
MsgBox "Please Complete Cardiac Standard", vbExclamation, "Required Data Missing"
Me.CardiacStandardI.SetFocus
Exit Sub
End If
If Me.RespStandardI.Value = "" Then
MsgBox "Please Complete Respiratory Standard", vbExclamation, "Required Data Missing"
Me.RespStandardI.SetFocus
Exit Sub
End If
If Me.VSI.Value = "" Then
MsgBox "PleaseComplete Vital Signs", vbExclamation, "Required Data Missing"
Me.VSI.SetFocus
Exit Sub
End If
If Me.NameI.Value = "" Then
MsgBox "Please Fill In Name Of Person Completing Audit", vbExclamation, "Required Data Missing"
Me.NameI.SetFocus
Exit Sub
End If
' ===============
' Message Box for possible wrong date (P shift)
' ===============
x = Me.TextBox3.Value
n = Now()
s = Me.ShiftI.Value
If Year(x) = Year(n) And Month(x) = Month(n) And Day(x) = Day(n) And Hour(n) < 19 And Me.ShiftI.Value = "PM/Night Shift" Then
MsgBox "You have submitted an audit for later tonight. The shift hasn't occurred yet. Please change the date to what the date was when the shift started.", vbExclamation, "Please choose acceptable date"
Me.NameI.SetFocus
Exit Sub
End If
' ===============
' Message Box for possible wrong date (A shift)
' ===============
x = Me.TextBox3.Value
n = Now()
s = Me.ShiftI.Value
If Year(x) = Year(n) And Month(x) = Month(n) And Day(x) = Day(n) And Hour(n) < 7 And Me.ShiftI.Value = "AM/Day Shift" Then
MsgBox "You have submitted an audit for later today. The shift hasn't occurred yet. Please change the date to what the date was when the shift started.", vbExclamation, "Please choose acceptable date"
Me.NameI.SetFocus
Exit Sub
End If
' ===============
' Message Box for future date
' ===============
x = Me.TextBox3.Value
n = Now()
s = Me.ShiftI.Value
If Year(x) >= Year(n) And Month(x) >= Month(n) And Day(x) > Day(n) Then
MsgBox "You have submitted an audit for a future date. Please change the date to what the date was when the shift started.", vbExclamation, "Please choose acceptable date"
Me.NameI.SetFocus
Exit Sub
End If
' ===============
' Ensures HAR entry is numeric (digits) only
' ===============
If Not IsNumeric(HARI.Value) Then
MsgBox "HAR can not have letters or symbols", vbExclamation, "Please enter correct HAR"
Me.HARI.SetFocus
Exit Sub
End If
' ===============
' Ensures HAR entry is 8 characters
' ===============
If PhysiologicalMonitoring.HARI.TextLength < 8 Then
MsgBox "HAR must be 8 digits", vbExclamation, "Please enter 8 digit HAR"
Me.HARI.SetFocus
Exit Sub
End If
' ===============
' This section below pastes data into the rows
' ===============
RowCount = Worksheets("Data").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Data").Range("A1")
.Offset(RowCount, 0).Value = Me.SLI.Value

<<<<THIS IS WHERE THE CODE FREEZES UP FROM WHAT I CAN TELL>>>>


.Offset(RowCount, 1).Value = Me.UnitI.Value
.Offset(RowCount, 2).Value = Me.TextBox3.Value
.Offset(RowCount, 3).Value = Me.ShiftI.Value
.Offset(RowCount, 4).Value = Format(Me.HARI.Value, "00000000")
.Offset(RowCount, 5).Value = Me.CMI.Value
.Offset(RowCount, 6).Value = Me.O2I.Value
.Offset(RowCount, 7).Value = Me.PulseOxI.Value
.Offset(RowCount, 8).Value = Me.CardiacStandardI.Value
.Offset(RowCount, 9).Value = Me.RespStandardI.Value
.Offset(RowCount, 10).Value = Me.VSI.Value
.Offset(RowCount, 11).Value = Me.NameI.Value
.Offset(RowCount, 12).Value = Me.CommentsI.Value
.Offset(RowCount, 13).Value = Me.CorrectI.Value
.Offset(RowCount, 14).Value = Format(Now, "mm/dd/yyyy hh:mm:ss")
End With
' ===============
' This section below opens the All Divisions workbook
' ===============
Workbooks.Open Filename:="L:\VMC Quality Audits\All Divisions-Data collection tool.xlsm", Password:="qr!", WriteResPassword:="qr!"
' ===============
' This section below pastes data into the rows in the All Divisions workbook, saves it, closes it
' ===============
RowCountAll = Worksheets("AllData").Range("A1").CurrentRegion.Rows.Count
With Worksheets("AllData").Range("A1")
.Offset(RowCountAll, 0).Value = Me.SLI.Value
.Offset(RowCountAll, 1).Value = Me.UnitI.Value
.Offset(RowCountAll, 2).Value = Me.TextBox3.Value
.Offset(RowCountAll, 3).Value = Me.ShiftI.Value
.Offset(RowCountAll, 4).Value = Format(Me.HARI.Value, "00000000")
.Offset(RowCountAll, 5).Value = Me.CMI.Value
.Offset(RowCountAll, 6).Value = Me.O2I.Value
.Offset(RowCountAll, 7).Value = Me.PulseOxI.Value
.Offset(RowCountAll, 8).Value = Me.CardiacStandardI.Value
.Offset(RowCountAll, 9).Value = Me.RespStandardI.Value
.Offset(RowCountAll, 10).Value = Me.VSI.Value
.Offset(RowCountAll, 11).Value = Me.NameI.Value
.Offset(RowCountAll, 12).Value = Me.CommentsI.Value
.Offset(RowCountAll, 13).Value = Me.CorrectI.Value
.Offset(RowCountAll, 14).Value = Format(Now, "mm/dd/yyyy hh:mm:ss")
End With
Workbooks("All Divisions-Data collection tool.xlsm").Save
Workbooks("All Divisions-Data collection tool.xlsm").Close True
' ===============
' This section clears the form
' ===============
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
End If
Next ctl
' ============
' Set default values
' ============
With Me.CorrectI
.Value = "No"
End With
With Me.TextBox3
.Value = Format(Date - 1, "mm/dd/yyyy")
End With
With Me.SLI
.Value = "AMS"
End With
' ================
' Unprotect Submitted worksheet
' ================
Worksheets("Submitted").Unprotect Password:="qr!"
' ===============
' Refresh the pivot table
' Pivot tables are named by right clicking on pivot table and choose 'pivot table options'
' ===============
Dim pvt As PivotTable
For Each pvt In Worksheets("Submitted").PivotTables
pvt.RefreshTable
Next
' ===============
' Delete all current filters in pivot table
' ===============
With Worksheets("Submitted").PivotTables("Submitted").ClearAllFilters
End With

' ===============
' Sort Pivot Table by Unit
' ===============
Worksheets("Submitted").PivotTables("Submitted").PivotFields("Unit").AutoSort xlAscending _
, "Unit"
Worksheets("Submitted").PivotTables("Submitted").PivotFields("Date").AutoSort xlAscending _
, "Date"
' ================
' Protect Data worksheet
' ================
Worksheets("Data").Protect Password:="qr!"
' ================
' Protect Submitted worksheet
' ================
Worksheets("Submitted").Protect Password:="qr!"
' ===============
' Save
' ===============
Workbooks("Medicine-Data collection tool.xlsm").Save


End Sub

I'm sorry I'm not complying with rules. I'm not familiar with how to do this. I will review those rules.

However, as far as the code goes....if the original code works well without the timer....and then I add the timer code and there are problems, don't you think the problem is in the timer code???

Ok. So I just found a page where people are using this same timer code. Because of the "do events", they say you can not run any other code with this timer code. <sigh> This is the problem when you borrow other people's code!!!!!

http://answers.microsoft.com/en-us/o...c-811cec8eda55

So I guess this can be tagged as "solved". I will search for another timer option!