VBA newbie here. I am looking for a way that will allow my excel file to automatically save after a delay of 1 min after data input.
For example:
User Inputs Data --> Timer Starts (1min)
5 seconds passes.
User inputs Data --> Timer Restarts (1min)
1 min passes.
Excel File Saves - until the user starts inputting data again
Any thoughts?
One possibility is to leverage the Workbook.SheetChange event and Application.OnTime. You'll also need a Public variable, ScheduledTime in the example below.
Every time any (non-chart) sheet is changed (e.g. via data entry):
Any previously scheduled save, as long as it's still within the one-minute window, is cancelled.
A new save is scheduled for one minute out.
So something like the following:
In the ThisWorkbook code module:
Option Explicit
Public ScheduledTime
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
On Error Resume Next
Application.OnTime EarliestTime:=ScheduledTime, Procedure:="SaveTheFile", Schedule:=False
On Error GoTo 0
ScheduledTime = Now + TimeValue("00:01:00")
Application.OnTime EarliestTime:=ScheduledTime, Procedure:="SaveTheFile"
End Sub
In a regular code module:
Public Sub SaveTheFile()
ThisWorkbook.Save
End Sub
You could just as well use the Worksheet Change event if you want to restrict this to a particular sheet.
I have a similar take on this to BigBen.
In ThisWorkbook module:
Option Explicit
Public SnapShot As String
Private Sub Workbook_Open()
StartTimer
End Sub
Sub StartTimer()
If SnapShot = vbNullString Then SnapShot = Now
If DateDiff("s", SnapShot, VBA.CStr(Now)) >= 10 Then ThisWorkbook.Save
RestartTimer
End Sub
Sub RestartTimer()
Application.OnTime Now + TimeValue("00:00:10"), "ThisWorkbook.StartTimer"
End Sub
And then in the worksheet you are monitoring:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.SnapShot = Now
End Sub
Related
Hello One of the VP where I work made a workbook that has the below macro in it. For some reason after I open the file and close it on my own the file re-opens itself every so often. Is this because the timer in the workbook is set to reset its closing process? I am not very well versed in VBA yet so that may not be even close to what the Sub Reset is doing. Note this apparently only happens to me and not anyone else and we have no idea why. only VBA experience I have is like making workbooks that don't close as pranks or making time stamps or color counting formulas.
Dim xTime As String
Dim xWB As Workbook
Private Sub Workbook_Open()
'Updated by Extendoffice 2019/1/20
On Error Resume Next
xTime = "00:30:00"
Set xWB = ActiveWorkbook
If xTime = "" Then Exit Sub
Reset
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
On Error Resume Next
If xTime = "00:30:00" Then Exit Sub
Reset
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If xTime = "" Then Exit Sub
Reset
End Sub
Sub Reset()
Static xCloseTime
If xCloseTime <> 0 Then
ActiveWorkbook.Application.OnTime xCloseTime, "SaveWork1", , False
End If
xCloseTime = Now + TimeValue(xTime)
ActiveWorkbook.Application.OnTime xCloseTime, "SaveWork1", , True
End Sub
The timer is a async process so it will keep running in background
you can reset it on closing of the workbook.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Reset
End Sub
The workbook is being reopened when Application.OnTime calls the SaveWork1 that is attached to it. Static xCloseTime is storing the time that the SaveWork1 is scheduled to be ran. The time is being stored so that the Application.OnTime event can be cancelled.
I believe that you are the only one being affected because you are the only one that dabbles in VBA. VBA errors may cause Static variables to lose their values. When Static xCloseTime the SaveWork1 is rescheduled.
I'm trying to close my workbook after a certain amount of time.
I'm using 10 seconds for now just to test it but it's not working automatically.
I have to run the code once by myself.
here's my code in module.
Public Sub fermeoutil()
Workbooks("OUTIL_CRN.xlsm").Save
Workbooks("OUTIL_CRN.xlsm").Close
Call test
End Sub
Sub test()
Application.OnTime Now + TimeValue("00:00:10"), "fermeoutil"
End Sub
In ThisWorkbook add procedure Workbook_Open with following code:
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:10"), "fermeoutil"
End Sub
In Module1 keep your current procedure fermeoutil() removing the call to test:
Public Sub fermeoutil()
Workbooks("OUTIL_CRN.xlsm").Save
Workbooks("OUTIL_CRN.xlsm").Close
End Sub
Your call to test (or Workbook_Open() as it is now called), is not needed, as you have left out the last argument of Application.OnTime, namely Schedule which is optional and has a default value of True meaning the event will be recurring. Not sure if that really is your meaning, since you are closing the wb.
My userform opens other workbooks but then remains over them. Can this be stopped? This also happens when clicking between open workbooks.
the code below works for me when activating a different sheet but not a different workbook.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name <> "HTFD" And Flight_Deck.Visible = True Then
Unload Flight_Deck
End If
If Sh.Name = "HTFD" And Flight_Deck.Visible = False Then
Flight_Deck.Show vbModeless
End If
End Sub
Since you were using code in the Private Sub Workbook_SheetActivate(ByVal Sh As Object), I'm assuming you know how to insert code into the ThisWorkbook Module. As well as the Workbook_SheetActivate there are also subs for the workbook activation and deactivation events.
Private Sub Workbook_Activate()
If Sh.Name = "HTFD" Then
Flight_Deck.Show vbModeless
End If
End Sub
Private Sub Workbook_Deactivate()
Flight_Deck.Hide
End Sub
You should also be able to insert code into the module for a particular sheet. If you do that, you could use the following code in the sheet module for which you want the userform to show, and since the code would only be activated when that particular sheet is activated, you won't have to do a check on the sheet's name. (The check on the sheet's name is required for the workbook_Activate code because that runs whenever the workbook is activated, not just for a particular sheet.)
Private Sub Worksheet_Activate()
Flight_Deck.Show vbModeless
End Sub
Private Sub Worksheet_Deactivate()
Flight_Deck.Hide
End Sub
Of course, with this setup, the userform will always be visible on that sheet in that workbook whenever anyone opens it. If you only want to initialize the userform after other code has ran, and/or you want to specifically close the userform at times; you should check if the userform is currently loaded.
This code was posted by gijsmo (April 24th, 2011, 14:08) on ozgrid.com (response #2)
Function IsUserFormLoaded(ByVal UFName As String) As Boolean
Dim UForm As Object
IsUserFormLoaded = False
For Each UForm In VBA.UserForms
If UForm.Name = UFName Then
IsUserFormLoaded = True
Exit For
End If
Next
End Function 'IsUserFormLoaded
Explanation
Using the Flight_Deck.Hide/Flight_Deck.Show combination should retain any information on the userform for when it's shown next. Exception: if the code is paused/stopped in between hiding and showing i.e. for debugging, the information will be lost.
Private Sub Worksheet_Activate() and Private Sub Worksheet_Deactivate() are triggered when the active worksheet changes, but the active workbook does not. Private Sub Workbook_Activate() and Private Sub Workbook_Deactivate() are triggered only when the active workbook changes. When either Private Sub Workbook_Activate() or Private Sub Workbook_Deactivate() are triggered, then neither Private Sub Worksheet_Activate() nor Private Sub Worksheet_Deactivate() are activated.
Thus, since you only want the userform to show over one particular sheet in one particular workbook, you will need code in both places.
Also, with this logic, I don't think it's necessary to check the status of Flight_Deck.Visible; however, I could be wrong.
I want to show a message 20 seconds after opening the Excel workbook. Code is:
//ThisWorkbook
Private Sub Workbook_Open()
SetTimer
End Sub
//Module1
Public Sub SetTimer()
Application.OnTime Now + TimeValue("00:00:20"), "ShowMsg"
End Sub
Public Sub ShowMsg()
MsgBox ("my message")
End Sub
As you see, code is very simple and it works when user don't update sheet or when they leave updated/focused cell. However, if cursor remains at cell the message will never be shown. It seams that control doesn't return to VBA code while a cell has focus or is updating. Any idea for this issue? Thanks
Here's a workaround:
Sub main()
Dim start As Single
start = Timer
Do
DoEvents
Loop Until Timer > (start + 20) '20 seconds
MsgBox "hello"
End Sub
Edit. Code for further question:
In a module called Module1, enter the following code:
Public start As Single
Sub main2()
start = Timer
Do
DoEvents
Loop Until Timer > (start + 20) '20 seconds
MsgBox "hello"
End Sub
In your ThisWorkbook object (double click on ThisWorkbook from the list of objects in the Project Explorer) enter the following code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Module1.start = Module1.start + 5
End Sub
Every time any cell in any worksheet in the workbook is changed, another five seconds is added to the timer.
I'm using the Application.Ontime event to pull a time field from a cell, and schedule a subroutine to run at that time. My Application.Ontime event runs on the Workbook_BeforeSave event. As such, if a user (changes the desired time + saves the workbook) multiple times, multiple Application.Ontime events are created. Theoretically I could keep track of each event with a unique time variable.. but is there a way to check/parse/cancel pending events?
Private Sub Workbook_BeforeSave
SendTime = Sheets("Email").Range("B9")
Application.OnTime SendTime, "SendEmail"
End Sub
Private Sub Workbook_BeforeClose
Application.OnTime SendTime, "SendEmail", , False
End Sub
So if I:
change B9 to 12:01, Save the workbook
change B9 to 12:03, Save the workbook
change B9 to 12:05, Save the workbook
change B9 to 12:07, Save the workbook
etc
I end up with multiple events firing. I only want ONE event to fire (the most recently scheduled one)
How can I cancel ALL pending events (or enumerate them at least) on the Workbook_BeforeClose event?
I don't think you can iterate through all pending events or cancel them all in one shabang. I'd suggest setting a module level or global boolean indicating whether or not to fire your event. So you'd end up with something like this:
Dim m_AllowSendMailEvent As Boolean
Sub SendMail()
If Not m_AllowSendMailEvent Then Exit Sub
'fire event here
End Sub
Edit:
Add this to the TOP of the sheet module which contains the range which contains the date/time value you're after:
' Most recently scheduled OnTime event. (Module level variable.)
Dim PendingEventDate As Date
' Indicates whether an event has been set. (Module level variable.)
Dim EventSet As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SendTimeRange As Range
' Change to your range.
Set SendTimeRange = Me.Range("B9")
' If the range that was changed is the same as that which holds
' your date/time field, schedule an OnTime event.
If Target = SendTimeRange Then
' If an event has previously been set AND that time has not yet been
' reached, cancel it. (OnTime will fail if the EarliestTime parameter has
' already elapsed.)
If EventSet And Now > PendingEventDate Then
' Cancel the event.
Application.OnTime PendingEventDate, "SendEmail", , False
End If
' Store the new scheduled OnTime event.
PendingEventDate = SendTimeRange.Value
' Set the new event.
Application.OnTime PendingEventDate, "SendEmail"
' Indicate that an event has been set.
EventSet = True
End If
End Sub
And this to a standard module:
Sub SendEmail()
'add your proc here
End Sub
Each time you call Application.Ontime save the time the event is set to run (you could save it on a sheet or in a module scoped dynamic array)
Each time your event fires, remove the corresponding saved time
To cancel all pending event iterate through the remaining saved times calling Application.Ontime with schedule = false
I think I may have a solution that works, based on some of the advice already given.
In short, we create a global array and each time the user hits save the SendTime is written to the array. This serves to keep track of all our scheduled times.
When the workbook is closed, we loop through the array and delete all scheduled times.
I tested this and it seemed to work on Excel 2003. Let me know how you get on.
Dim scheduleArray() As String //Set as global array to hold times
Private Sub Workbook_BeforeSave
SendTime = Sheets("Email").Range("B9")
AddToScheduleArray SendTime
Application.OnTime SendTime, "SendEmail"
End Sub
Private Sub Workbook_BeforeClose
On Error Resume Next
Dim iArr As Integer, startTime As String
For iArr = 0 To UBound(scheduleArray) - 1 //Loop through array and delete any existing scheduled actions
startTime = scheduleArray(iArr)
Application.OnTime TimeValue(startTime), "SendEmail", , False
Next iArr
End Sub
Sub AddToScheduleArray(startTime As String)
Dim arrLength As Integer
If Len(Join(scheduleArray)) < 1 Then
arrLength = 0
Else
arrLength = UBound(scheduleArray)
End If
ReDim Preserve scheduleArray(arrLength + 1) //Resize array
scheduleArray(arrLength) = startTime //Add start time
End Sub
or you can just create some cell (like abacus), for example:
if I use application.ontime:
if range("V1") < 1 then
Application.OnTime dTime, "MyMacro"
range("V1")=range("V1") + 1
end if
if I want to stop counting...
Application.OnTime dTime, "MyMacro", , False
range("V1")=range("V1") - 1