This is Excel 2003.
I'd like to know how long it takes an external query to complete and then update a cell in my spreadsheet with that ET. I have the following, but it doesn't work because the ET is only as long as it takes to initiate the refresh:
Sub Refresh()
Dim StartTime, EndTime, ET
StartTime = Timer
ActiveWorkbook.RefreshAll
EndTime = Timer
ET = Format(EndTime - StartTime, "Fixed")
Range("H27").Value = ET
MsgBox (ET)
End Sub
So the ET is about 1 second, even though the data fetch takes a good 10 minutes.
The easy way out is to set background refresh to false, but this blocks the whole application and makes life miserable for a long time.
Is there some kind of signal or exception that I can catch in VBA that indicates "oh, a background refresh is done; now you can stop your timer and calculate the ET"?
Thanks!
I guess you need to use the AfterRefresh event.
Here is a forum discussion with a happy ending and examples.
Pasting the example from the referred page, just for link independence (you should add your timer storage and arithmetic):
This code goes on a Module:
Dim X As New Class1
Sub Initialize_It()
Application.DisplayAlerts = False
Application.ScreenUpdating = True
diropen = "C:\Desktop\"
Workbooks.Open diropen & "Test.xls" , UpdateLinks:=0
Set X.qt = Workbooks("Test.xls").Sheets("Sheet1").QueryTables(1)
ActiveWorkbook.RefreshAll
End Sub
This code goes on a Class Module:
Public WithEvents qt As QueryTable
Private Sub qt_AfterRefresh(ByVal Success As Boolean)
' Declare variables.
Dim a As Integer
Dim My_Prompt As String
' Initialize prompt text for message box.
My_Prompt = "Data refreshed or canceled."
' Displays message box before refresh (or cancel) occurs.
MsgBox My_Prompt
ActiveWorkbook.Save
Workbooks("Test.xls").Close
End Sub
Related
I have a workbook which I use to value my investment portfolio. It includes UDFs which scrape data from some websites where Excel's stocks data type is not available. The UDFs work well but they take a little time to calculate. I would like for the UDFs to only run when I hit F9 but not when I open the workbook but I can't work out how to achieve this. Is there something like "If running as part of loading up the workbook then do this..."?
I have Calculation=Automatic and Application.Volatile(False).
Thank you for any suggestions.
I'm not sure it's necessary, here is one of the UDFs:
`
Function GetLSEPrice(ticker As String) As Double
Application.Volatile (False)
Dim driver As New ChromeDriver
Dim url As String
Dim y As Selenium.WebElement
url = "https://www.londonstockexchange.com/stock/" & _
ticker & _
"/united-kingdom/company-page"
driver.AddArgument "--headless"
driver.Get url
Set y = driver.FindElementByClass("price-tag")
GetLSEPrice = CDbl(y.Text)
End Function
`
The following should do it;
Step 1) - Create a New Property in your Workbook - to count how many times the various UDFs are called
Step 2) - Add Code in the UDF's to Test that Counter
I've Added Code to the SheetSelectionChange Event (Just to help trigger the UDF's)
AS follows;
Public UDFCallCtr As Long
Private Sub Workbook_Open()
ThisWorkbook.UDFCallCtr = 1 ' Not Really Reqd
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CalculateFull
End Sub
This is the UDF I've tested it with
Public Function UDFTester() As String
If ThisWorkbook.UDFCallCtr > 5 Then ' Change 5 to any value that works for you
' Put you Code here
UDFTester = "Time is now " & Now()
' Done
Else
UDFTester = "NOT READY YET"
ThisWorkbook.UDFCallCtr = ThisWorkbook.UDFCallCtr + 1
End If
End Function
The following may help show where the code goes
The Workbook.BeforeClose event triggers when the workbook is about to close but before the saving message prompt which allows cancelling it.
How can I detect when the workbook is already closing past the point where it can be cancelled without removing nor replacing the saving message with a custom one?
One workaround I have found online is to use the event together with the Workbook.Deactivate event which looks like this:
Code in the workbook:
Private Sub Workbook_BeforeClose(ByRef Cancel As Boolean)
closing_event = True
check_time = VBA.Now + VBA.TimeSerial(Hour:=0, Minute:=0, Second:=1)
Excel.Application.OnTime EarliestTime:=check_time, Procedure:="disable_closing_event"
End Sub
Private Sub Workbook_Deactivate()
If closing_event Then
VBA.MsgBox Prompt:="Closing event."
Excel.Application.OnTime EarliestTime:=check_time, Procedure:="disable_closing_event", Schedule:=False
End If
End Sub
Code in a module:
Public closing_event As Boolean
Public check_time As Date
Public Sub disable_closing_event()
closing_event = False
End Sub
One very specific edge case where it triggers incorrectly is if you click to close the workbook and in less than one second close the saving message (press Esc to do it fast enough) and change to another workbook (Alt + Tab) it triggers the Deactivate event with the closing_event condition variable still set to True because disable_closing_event has still not set it to False (scheduled by Application.OnTime for when one second goes by).
I would like to find a solution that isn't so much of a workaround and that works correctly against that edge case.
Edit:
The accepted answer has the best solution in my opinion out of all the current answers. I have modified it for my needs and preference to the following code in the workbook:
Private WorkbookClosing As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
WorkbookClosing = True
End Sub
Private Sub Workbook_Deactivate()
If WorkbookClosing And ThisWorkbook.Name = ActiveWindow.Caption Then
Workbook_Closing
Else
WorkbookClosing = False
End If
End Sub
Private Sub Workbook_Closing()
MsgBox "Workbook_Closing event."
End Sub
This is an evolution of my 1st Answer - it detects the edge case problem by comparing the ActiveWindow.Caption against ThisWorkbook.Name so it can detect that issue and deal with it. It's not the most elegant solution but I believe it works.
All Code in the Workbook most of it in DeActivate
Public ByeBye As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ByeBye = "B4C"
End Sub
Private Sub Workbook_Deactivate()
If ByeBye = "B4C" Then
If ActiveWindow.Caption = ThisWorkbook.Name Then
If ThisWorkbook.Saved Then
MsgBox "No problem - Closing after Saving"
Else
MsgBox "No problem - Closing without Saving"
End If
Else
If ThisWorkbook.Saved Then
MsgBox "No problem - New Workbook Activation"
Else
MsgBox "Oops Try Again You Cannot Activate '" & ActiveWindow.Caption & "' until '" & ThisWorkbook.Name & "' has completed processing & IT HAS NOW COMPLETED", vbOKOnly, "Hiding"
ThisWorkbook.Activate
End If
End If
Else
MsgBox "No problem - Just Hiding"
End If
ByeBye = "Done"
End Sub
Private Sub Workbook_Open()
ByeBye = "OPENED"
End Sub
In response to comment about saving I tested this for 7 possible combinations as follows
1) Closing without Edits - No Saving Involved ... MsgBox Prompted with ... No problem - Closing after Saving
2) Not closing - Just Switch Workbook - Whether Edited or Not ... MsgBox Prompted with ... No problem - Just Hiding
3) Not closing - Switch Workbook - After Edit & Cancel ... MsgBox Prompted with ... Oops Try Again …
4) Closing and saving ... MsgBox Prompted with ... No problem - Closing after Saving
5) Closing and Saving after a prior Cancel ... MsgBox Prompted with ... No problem - Closing after Saving
6) Closing but Not Saving ... MsgBox Prompted with ... No problem - Closing without Saving
7) Closing but not Saving after a prior Cancel ... MsgBox Prompted with ... No problem - Closing without Saving
I think trying to cancel the close event is the wrong approach for what you are trying to do. A better approach would be to have a function that is only called when the workbook is actually closing.
Thank you for the comments regarding OnTime not being called while the dialog is open as that pointed me in the right direction. What we need to test is the time between the workbook deactivation and the closing of either the workbook itself or the save dialog. Using the Excel.Application.OnTime function to set this close time means this is possible as it can be delayed until the save dialogue has closed.
Once we have this time, a simple comparison to the deactivation time allows us to decide whether to call the exit function or not.
I initially ran into issues with the workbook reopening to run the .OnTime procedure, so an artificial delay needs to be added into the Deactivation function so the workbook hasn't closed until the close time has been set. Using the code from here - Delay Macro to allow events to finish we can accomplish this.
In ThisWorkbook
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Excel.Application.OnTime EarliestTime:=Now, Procedure:="SetCloseTime"
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Timer < CloseTime + 0.2 Then Call CloseProcedure
End Sub
Private Sub Workbook_Deactivate()
Delay (0.3)
If Timer < CloseTime + 0.4 Then Call CloseProcedure
End Sub
In a module
Option Explicit
Public CloseTime As Single
Function SetCloseTime()
CloseTime = Timer
End Function
Function Delay(Seconds As Single)
Dim StopTime As Single: StopTime = Timer + Seconds
Do While Timer < StopTime
DoEvents
Loop
End Function
Function CloseProcedure()
MsgBox "Excel is closing"
End Function
The .OnTime seems to run within one second cycles which dictates the length of the delay and the time difference test has a little leeway added with an additional 1/10th of a second (which I found necessary). These timings could potentially need slight tweaking but have so far worked for me with the different scenarios when closing the workbook.
In order to get around your edge case, you need to handle the case where the workbook is deactivated within 1 second of closing it, but only when the save prompt was displayed.
To check if less than 1 second has elapsed, use a high resolution timer to store the time in the Workbook_BeforeClose event, and then compare against it in the Workbook_Deactivate event. Assuming that clsTimer is a suitable high res timer, your code should now be:
Private MyTimer As clsTimer
Private StartTime As Currency
Private Sub Workbook_BeforeClose(ByRef Cancel As Boolean)
closing_event = True
Set MyTimer = New clsTimer
StartTime = MyTimer.MicroTimer
check_time = VBA.Now + VBA.TimeSerial(Hour:=0, Minute:=0, Second:=1)
Excel.Application.OnTime EarliestTime:=check_time, Procedure:="disable_closing_event"
End Sub
Private Sub Workbook_Deactivate()
If closing_event Then
If Not ThisWorkbook.Saved Then
'The Save prompt must have been displayed, and the user clicked No or Cancel or pressed Escape
If MyTimer.MicroTimer - StartTime < 1 Then
'The user must have pressed Escape and Alt-Tabbed
closing_event = False
Else
'Your Windows API calls here
End If
Else
'The workbook was saved before the close event, so the Save prompt was not displayed
'Your Windows API calls here
End If
Excel.Application.OnTime EarliestTime:=check_time, Procedure:="disable_closing_event", Schedule:=False
End If
Set MyTimer = Nothing
End Sub
The class module for clsTimer looks like this:
Private Declare PtrSafe Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Public Function MicroTimer() As Currency
' Returns seconds.
Dim cyTicks1 As Currency
Static cyFrequency As Currency
MicroTimer = 0
' Get frequency.
If cyFrequency = 0 Then getFrequency cyFrequency
' Get ticks.
getTickCount cyTicks1
' Seconds
If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function
This post could be helpful https://www.dummies.com/software/microsoft-office/excel/an-excel-macro-to-save-a-workbook-before-closing/
I found code below from the book Excel 2016 Power Programming with VBA, by Michael Alexander
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim msg As String, ans as integer
If Me.Saved = False Then
msg = "Do you want to save?"
ans = MsgBox(msg, vbquestion+vbyesnocancel)
Select Case ans
Case vbYes: Me.Save
Case vbCancel: Cancel = True
End Select
End If
Call mySub
Me.Saved = True
End Sub
I think deactivate is the best way to capture this.
Beforeclose might occur earlier than Save event if the document was not saved. So Excel might prompt to save before closure.
But Deactivate is the final event before closure (after save). So this can be used.
had a similar problem and tried to run some macro before closing but it is dependad whether user wants to save workbook or not.
My solution was the code below, though there is a problem, that window of excel always stays open.
Public ClosedByProgram As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not ClosedByProgram Then
Cancel = True
Dim Ans As String
Ans = MsgBox("Want to save your changes to '" & ThisWorkbook.Name & "'?", vbYesNoCancel, "Microsoft Excel")
If Ans = vbNo Then
ClosedByProgram = True
ThisWorkbook.Close
ElseIf Ans = vbYes Then
Dim STR As String: STR = "'" & ThisWorkbook.Name & "'!" & "mod16_Versioning.IsSuitableForSaving"
Dim isForSaving As Boolean: isForSaving = Application.Run(STR, SaveAsUI)
If isForSaving Then
Dim STRToRun As String
STRToRun = "'" & ThisWorkbook.Name & "'!" & "mod02_Events.BeforeSave"
Application.Run STRToRun, SaveAsUI
Dim STRVersions As String: STRVersions = "'" & ThisWorkbook.Name & "'!" & "mod16_Versioning.MakeVersion"
Dim blankCheck As Boolean: blankCheck = Application.Run(STRVersions, SaveAsUI)
ClosedByProgram = True
ThisWorkbook.Close
End If
End If
Else
ThisWorkbook.Saved = True
Application.Quit
End If
End Sub
This seems to work
Code in the WorkBook
Public ByeBye As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ByeBye = "BB # " & Now()
End Sub
Private Sub Workbook_Deactivate()
If Left(ByeBye, 2) = "BB" Then
ByeBye="Done"
MsgBox "Closing"
Else
ByeBye="Done"
MsgBox "DeActivating BUT NOT Closing"
End If
End Sub
Private Sub Workbook_Open()
ByeBye = "OP # " & Now()
End Sub
Just uses a public variable ByeBye
You must initialise it in WorkBook.Open
You must Set it in WorkBook.BeforeClose
and can test it in WorkBook.DeActivate
In case it is needed for this to work even after a VBA crash - and loss of ByeBye value I'm resetting it in the Workbook_SheetChange and in WorkBook_SheetSelectionChange
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ByeBye = "SC # " & Now()
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ByeBye = "SSC # " & Now()
End Sub
The above addendum is really only needed if you were going to use the string default of "" for the tested value - but I'm using "BB # " & Now() so this is not really needed
Something which we encounter on a daily basis at work is when a member of the team opens Excel Workbook from a network share to update the workbook and forget to save and close the file after he is finished.
The issue arise when the user locks his workstation and walks away from his desk leaving his co-workers unable to modify the shared excel workbook (read only).
P.S Locking your workstation before each time you leave your desk is something crucial for security reasons and I encourage the reader to adopt this good cyber hygiene habit.
How can I solve this issue once and for all?
One might argue that opening such documents in the cloud might solve the problem but this depends on the nature of the contents being stored in the document.
I had some initial parameters defined wrong and it's always better to do stuff like this at the Modules level.
For your ThisWorkbook section, only have this code:
Private Sub Workbook_Open()
Call TheTimerMac
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call RestApplicationTimer
End Sub
Then in a standard Module insert the below code. The settings can be adjusted with the constants, which it looks like you understand (btw thanks for CDATE function -- shorter than TimeValeu)
I also inserted a couple audio warnings, partially just for my own entertainment. You look sharp enough that you can just nuke them if you don't like them.
'STANDARD MODULE CODE
'Constants
'Time settings
Const idleTimeLIMIT As String = "00:35:00" '<---- Edit this to whatever timer you want (hour:min:sec)
Const checkIntervalTime As String = "00:01:00" '<---- this can be executed frequently as it has low overhead
'Set this variable TRUE to confirm the macro is working with popup messages
Const conFirmRunning As Boolean = False
Dim LastCalculate As Date 'Make sure this is outside and above the other macros
Option Private Module
Public Sub TheTimerMac()
'message you can have displayed to make sure it's running
If conFirmRunning Then MsgBox "TheTimerMac is running."
'Schedules application to execute below macro at set time.
Application.OnTime Now + CDate(checkIntervalTime), "AnyBodyWorking"
End Sub
Private Sub AnyBodyWorking()
'OPTIONAL Warning messages to be spoken
Const TenMinuteWarning As String = "Your file will save and close in approximately 10 minutes"
Const FiveMinuteWarning As String = "Your file will save and close in approximately 5 minutes"
Const OneMinuteWarning As String = "This is the last warning. Your file will save and close in a little over a minute."
'message you can have displayed to make sure it's running
If conFirmRunning Then MsgBox "AnyBodyWorking Macro is running."
If LastCalculate = 0 Then
'Won't close application if lastCalc hasn't been set
Call RestApplicationTimer
ElseIf Now > LastCalculate Then
'if nothing has happened in the last idleTime interval... then it closes.
'close and lock it up!!
ThisWorkbook.Save
ThisWorkbook.Close
Exit Sub 'not even sure if this is needed, but probably good to be sure
''Optional spoken warnings
ElseIf DateDiff("S", Now, LastCalculate) < 60 Then
Application.Speech.Speak OneMinuteWarning
ElseIf DateDiff("S", Now, LastCalculate) < 300 Then
Application.Speech.Speak FiveMinuteWarning
ElseIf DateDiff("S", Now, LastCalculate) < 600 Then
Application.Speech.Speak TenMinuteWarnin
End If
Call TheTimerMac
End Sub
Sub RestApplicationTimer()
LastCalculate = Now + CDate(idleTimeLIMIT)
End Sub
Lastly, I think you could slightly improve the the locked function to be as follows and you could inculde it in your if statements.
Function IsLocked() As Boolean
IsLocked = _
GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
Environ$("computername") & "\root\cimv2"). _
ExecQuery("select * from Win32_Process where Name='logonui.exe'").Count > 0
End Function
Save the excel file as .xlsm to enable the storing of macros in the workbook itself.
Go to: Developer Tab -> Visual Basic
Double click: 'This Workbook', on the left hand pane
Paste the following VBA code:
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:01:00"), "Save1"
End Sub
Right Click VBAProject -> Insert -> Module
Paste the following VBA Code:
Sub Save1()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
If IsLocked(Environ$("computername")) > 0 Then
Workbooks("book1test.xlsm").Close SaveChanges:=True
End If
Application.OnTime Now + TimeValue("00:01:00"), "Save1"
End Sub
Function IsLocked(strComputer)
With GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
IsLocked = .ExecQuery("select * from Win32_Process where Name='logonui.exe'").Count '
End With
End Function
Save the Macro: Ctrl+s
This macro will be triggered every time you open the workbook, save your work every minute and only close the workbook if your screen/workstation is logged. You can remove the auto-save feature if you want.
Credits:
Check if computer is locked using VBscript
How to save Excel file every say minute?
#PGSystemTester this was the only way I could get it to work:
In ThisWorkbook:
Public idleTIME As Date '<---- Edit this to whatever timer you want (hour:min:sec)
Private Sub Workbook_Open()
idleTIME = CDate("00:10:00")
LastCalculate = Now + idleTIME
Check
End Sub
Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
LastCalculate = Now + idleTIME
End Sub
In module Option 1:
Public LastCalculate As Date
Const checkIntervalTime As String = "00:01:00"
Sub Check()
Call TheTimerMac
End Sub
Private Sub TheTimerMac()
Dim nextRunTime As Date
nextRunTime = Now + CDate(checkIntervalTime)
'Schedules application to execute below macro at set time.
Application.OnTime nextRunTime, "AnyBodyWorking"
End Sub
Private Sub AnyBodyWorking()
If Now > LastCalculate Then
'if nothing has happened in the last idleTime interval... then it closes.
'close and lock it up!!
ThisWorkbook.Save
ThisWorkbook.Close
Else
'executes the timerMacagain
Call TheTimerMac
End If
End Sub
module Option 2 (for locked screen):
Public LastCalculate As Date 'Make sure this is outside and above the other macros
Const checkIntervalTime As String = "00:00:30" '<---- this can be frequent as it has low overhead
Sub Check()
Call TheTimerMac
End Sub
Private Sub TheTimerMac()
Dim nextRunTime As Date
nextRunTime = Now + CDate(checkIntervalTime)
'Schedules application to execute below macro at set time.
Application.OnTime nextRunTime, "AnyBodyWorking"
End Sub
Private Sub AnyBodyWorking()
If Now > LastCalculate Or (IsLocked("FIBRE-X") > 0) Then
'if nothing has happened in the last interval idleTime OR Screen is Locked... then it closes.
'close and lock it up!!
ThisWorkbook.Save
ThisWorkbook.Close
Else
'executes the timerMacagain
Call TheTimerMac
End If
End Sub
Function IsLocked(strComputer)
With GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
IsLocked = .ExecQuery("select * from Win32_Process where Name='logonui.exe'").Count '
End With
End Function
Anything I can improve on this please?
I am experiencing an odd bug on Excel. I have a macro that shows a non-modal userform when I press CTRL+m (Macro shortcut). Every once in a while, and it's not that frequent (Shows up once or twice during the day, I use the macro every 5 minutes or so), Excel won't run the macro, won't show the userform and will just beep (as in "mistake, cannot proceed executing code").
I went into the Macro window to try to press "Run" and manually execute, but all buttons are disabled, except for "Create". If you click it, it says the macro name is not valid. As you can see in the screenshot below, the name of the macro shows the instance where the code is (Sheet1 of the workbook).
Sometimes it can be fixed by saving the workbook and just re-trying, but sometimes it doesn't; when it doesn't, I run a different macro (by double clicking a specific column) that shows a modal userform, and executing its code. Then my first macro returns to normal.
Any help will be very much appreciated.
Edit: Adding the code as requested in the comments
Sub ShowCommentWindow()
Dim myCell As Range
Dim companyColumn As Long
Dim wbk as Workbook
Dim company as String
Dim phone as Long
Set wbk = ActiveWorkbook
For Each myCell In wbk.Worksheets(1).Range("A1:Q1")
If myCell.Text = "Company" Then
companyColumn = myCell.Column
company = ActiveCell.Text
phone = ActiveCell.Offset(0, 4).Value
Exit For
End If
Next myCell
If ActiveCell.Column = companyColumn Then
If EmailForm.Visible Then
GoTo ExitProc
Else
If Not ActiveCell.Row < 4 Then
ActiveWindow.ScrollRow = ActiveCell.Row - 3
Else
ActiveWindow.ScrollRow = ActiveCell.Row
End If
If CommentWindow.Visible Then
CommentWindow.AddButton.SetFocus
CommentWindow.CommentBox.SetFocus
Exit Sub
Else
CommentWindow.Show
ManageComments
AddComment
End If
End If
End If
ExitProc:
End Sub
Edit2: Posting more code, for QueryClose:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim myCell As Range
Dim isCompany As String
If Not CommentWindow.CommentBox.Text = CommentWindow.TextCopy.Text Then
saveConf = MsgBox("Changes have not been saved yet. Do you want to save?", vbExclamation + vbYesNoCancel + vbDefaultButton2, "Save changes?")
If saveConf = vbYes Then
Call SaveComment
GoTo ExitProc
ElseIf saveConf = vbCancel Then
changed = True
Cancel = 1
CommentWindow.AddButton.SetFocus
CommentWindow.CommentBox.SetFocus
'CommentWindow.CommentBox.Text = CommentWindow.TextCopy.Text
Else
CommentWindow.TextCopy.Text = CommentWindow.CommentBox.Text
GoTo ExitProc
End If
Else
If Not changed = True Then
GoTo ExitProc
End If
End If
ExitProc:
End Sub
Seems like the issue is not unloading the forms from ( Unload(UserForm) )
This leads to a memory leak.
Even the official documentation -this refers to Access, but, should behave the same for Excel (there's no Form object or userform documentation there)- state the Lifecycle is Unload->Deactivate->Close, and this should happen when you close the userform as well, daily usage has shown that Unload if not stated may not be triggered when closing the userform.
The lifecycle is not that strictly monitored sometimes, but, that may lead to memory leaks and strange behaviors, always when working with objects you shouldn't rely that garbage collector will clean them if not specified. Probably adding something to confirm that terminate is being correctly handled will be helpful.
EDIT
If you're having problems remembering the unload -or still having problems with memory-, it will be a good practice to do the following:
Sub MyMainProcess()
Dim myform As UserForm1: Set myform = UserForm1 'this is your UserForm name
myform.Show
'my stuff needed...
Unload myform
Set myform = Nothing
End Sub
Unload and Nothing to clean as much as possible with coding
I see that you're calling an "outside" macro (it's not within the active workbook) - Is it possible that then those roughly 2 times a day that it doesn't work that workbook (Database 2 Lumber.xlsm) is being used by someone else at that time (eight running that, or another macro?).
If so, What I have done before is save a local copy of the workbook each time the macro is run
I was thinking it would be a nice convenience if, while a bunch of people are viewing the same workbook for read-only, they could be notified with a pop-up on their screen every time the workbook has been updated. That way they know right away what they are looking at may no longer be accurate. Thanks
Here is a crafty little way of doing what you want. The idea is to get FileDateTime(ThisWorkbook.FullName), the date the workbook file was last modified. You first get this date at the time of opening the workbook, store it in a cell in your workbook, and then check back periodically whether FileDateTime(ThisWorkbook.FullName) returns a date different from what was stored.
In this example I store the date in Sheet1.Range("A1"), but you could store it in a hidden sheet or wherever.
In your ThisWorkbook module, define the Workbook_Open event as follows:
Private Sub Workbook_Open()
userNotified = False
'Store date last modified.
dateLastModifiedWhenOpened = FileDateTime(ThisWorkbook.FullName)
'How often will we check back?
runTimeInterval = TimeValue("00:00:05")
'Set timer for next check.
Application.OnTime Now + runTimeInterval, _
"CheckWhetherThisWorkbookFileModifiedSinceOpening"
End Sub
In a code module:
Public dateLastModifiedWhenOpened As Date
Public nextRunTime As Date
Public runTimeInterval As Date
Public userNotified As Boolean
Sub CheckWhetherThisWorkbookFileModifiedSinceOpening()
If Not FileDateTime(ThisWorkbook.FullName) = dateLastModifiedWhenOpened Then
MsgBox "This workbook file has been modified since you opened it." _
& vbCrLf & "Modified at: " & FileDateTime(ThisWorkbook.FullName)
userNotified = True
Else
'Set timer for next check.
nextRunTime = Now + runTimeInterval
Application.OnTime nextRunTime, _
"CheckWhetherThisWorkbookFileModifiedSinceOpening"
End If
End Sub
It may be a good idea to clean up upon closing the workbook. In your ThisWorkbook module:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not userNotified Then
'Cancel the next check.
Application.OnTime nextRunTime, _
"CheckWhetherThisWorkbookFileModifiedSinceOpening", , False
End If
End Sub
You can share your workbook via the Review ribbon, Share Workbook.
In the advanced options you can set "Update changes" to as often as 5 minutes. In your case you probably want "Just see other users' changes".