File sporadically reopens itself
We have a big excel file that reopens itself sporadically - despite the beforeclose routine. I cannot find a pattern.
This is so weird - we have 10 people in and out of this file several times a day and this is the first time it has happened in a week! With no change to the code. I'm hoping you can take a look and help me find what is causing this!
code in sheet 1
Code:
Option Explicit
Dim PreviousValue
Private Sub Worksheet_Change(ByVal Target As Range)
'define variables
Dim sLogFileName As String, nFileNum As Long, sLogMessage As String
'only do these things if NOT read-only
If ThisWorkbook.ReadOnly = False Then
'do not log inserting of rows or columns (as this would only be done by admin after unprotecting sheet)
If Target.Rows.Count > 1 Then Exit Sub
If Target.Columns.Count > 1 Then Exit Sub
'define path for log file - be sure to use network path - not mapped drives to avoid errors with users not mapped the same
sLogFileName = "\\w2kdata1571\FinanceDept\Data Quality\SOX\ICRR Documentation\Tracker Historical Versions\Reconciliations\Tracker Log.txt"
' Turn on error handling
On Error Resume Next
If Target.Value <> PreviousValue Then
'Check if we have an error
If Err.Number = 13 Then
PreviousValue = 0
End If
'Turn off error handling
On Error GoTo 0
'define log data
sLogMessage = Now & Application.UserName & " changed cell " & Target.Address _
& " from " & PreviousValue & " to " & Target.Value
'next file number
nFileNum = FreeFile
'create the file if it doesn't exist
Open sLogFileName For Append As #nFileNum
'append information
Print #nFileNum, sLogMessage
'close the file
Close #nFileNum
'if activity, reset the timer
Monitor OnTimeAction:=xlOnTimeUpdate
End If
Else
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target(1).Value
'if activity, reset the timer
Monitor OnTimeAction:=xlOnTimeUpdate
End Sub
Code in this workbook:
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'only do these things if NOT read-only
If ThisWorkbook.ReadOnly = False Then
'reset calculation to automatic
Application.Calculation = xlCalculationAutomatic
'save the workbook
'Me.Save
'Else
'End If
Monitor OnTimeAction:=xlOnTimeStop
Else
End If
End Sub
Private Sub Workbook_Open()
'unprotect and unfilter the active sheet
With ActiveSheet
ActiveSheet.Unprotect Password:="icrr"
If .FilterMode Then
.ShowAllData
End If
'reprotect the active sheet, allowing filtering and pivot tables
ActiveSheet.Protect Password:="icrr", _
DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True, AllowUsingPivotTables:=True
'End If
End With
'start inactivity timer
Monitor OnTimeAction:=xlOnTimeStart
End Sub
'check for activity
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Monitor OnTimeAction:=xlOnTimeUpdate
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Monitor OnTimeAction:=xlOnTimeUpdate
End Sub
Code in Module 1
Dim TimeNow As Date
'set number of minutes between popups if idle
Public Const Idletime As String = "00:010:00"
Enum XLOnTimeSetting
xlOnTimeStart
xlOnTimeUpdate
xlOnTimeStop
End Enum
Sub Monitor(ByVal OnTimeAction As XLOnTimeSetting)
'Only run this sub-routine if NOT Read Only
If ThisWorkbook.ReadOnly Then Exit Sub
On Error Resume Next
Top:
Select Case OnTimeAction
Case xlOnTimeStart
TimeNow = Now + TimeValue(Idletime)
Application.OnTime TimeNow, "CheckActivity"
Case xlOnTimeStop, xlOnTimeUpdate
Application.OnTime EarliestTime:=TimeNow, Procedure:="CheckActivity", Schedule:=False
If OnTimeAction = xlOnTimeUpdate Then OnTimeAction = xlOnTimeStart: GoTo Top
End Select
On Error GoTo 0
End Sub
Sub CheckActivity()
'text for popup box
MsgBox "This File Has Been Idle for 10 Minutes" & vbCr & " Please Save and Close Now"
'restart timer after popup
Monitor OnTimeAction:=xlOnTimeStart
End Sub
Recent comments
5 years 34 weeks ago
6 years 20 weeks ago
6 years 32 weeks ago
6 years 35 weeks ago
6 years 36 weeks ago
6 years 42 weeks ago
6 years 50 weeks ago
6 years 50 weeks ago
6 years 50 weeks ago
6 years 50 weeks ago