I have a button that triggers a chain of events. One of these events is to delete a sheet. Before the user deletes anything, I pop up my custom YES/NO message asking them to confirm the whole process.
Then comes the sub event of deleting the sheet, and Excel pops up its own window for confirming the removal of the sheet. Problem is that if the user says "no" at that point, that sets my application in an inconsistent state.
How can I bypass Excel asking to confirm the deletion of a sheet ?
You can change the default display alert parameter of Excel using:
Application.DisplayAlerts = False
don't forget to restore the standard behavior at the end of your process:
Application.DisplayAlerts = True
I ran into this issue using Excel 2016, and surprisingly DisplayAlerts was useless. Not sure if anyone else has experienced this. I'm still unsure as to why, but reading this thread, according to the remarks of the Worksheet.Delete method (here):
When you delete a Worksheet , this method displays a dialog box that prompts the user to confirm the deletion. This dialog box is displayed by default. When called on the Worksheet object, the Delete method returns a Boolean value that is False if the user clicked Cancel on the dialog box or True if the user clicked Delete.
In Excel 2016, though Application.DisplayAlerts was set to False, it kept showing the alert after (or rather before) deletion.
I haven't found a true work around yet, so I'm simply making the sheets I want to delete "disappear" using a for each loop:
Sht.UsedRange.clear
For each shp in sht.Shapes
shp.Delete
Next
For each nm in sht.Parent.Names
if nm.RefersToRange.Parent is sht then nm.Delete
Next
sht.visible = xlSheetVeryHidden
(code is an unchecked draft; eventual errors can be treated with an on error resume next mostly)
It's far from ideal, but it does what I need done (at the cost of more memory, sure). Maybe I should turn this reply into a question and see if someone has a better idea for Excel 2016.
TO DELETE ALL SHEETS WITH OUT "REPORT" SHEET **
Dim NM As String
Dim CTS As Integer
Dim CNT2 As Integer
Dim CNT3 As Integer
CNT3 = 1
CNT2 = 1
CTS = Sheets.Count
Do Until CNT2 = CTS + 1
NM = Sheets(CNT3).Name
If Name = "Report" Then
Range("A1").Select
CNT3 = CNT3 + 1
Else
Sheets(NM).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End If
CNT2 = CNT2 + 1
Loop
Related
My Excel tool performs a long task, and I'm trying to be kind to the user by providing a progress report in the status bar, or in some cell in the sheet, as shown below. But the screen doesn't refresh, or stops refreshing at some point (e.g. 33%). The task eventually completes but the progress bar is useless.
What can I do to force a screen update?
For i=1 to imax ' imax is usually 30 or so
fractionDone=cdbl(i)/cdbl(imax)
Application.StatusBar = Format(fractionDone, "0%") & "done..."
' or, alternatively:
' statusRange.value = Format(fractionDone, "0%") & "done..."
' Some code.......
Next i
I'm using Excel 2003.
Add a DoEvents function inside the loop, see below.
You may also want to ensure that the Status bar is visible to the user and reset it when your code completes.
Sub ProgressMeter()
Dim booStatusBarState As Boolean
Dim iMax As Integer
Dim i As Integer
iMax = 10000
Application.ScreenUpdating = False
''//Turn off screen updating
booStatusBarState = Application.DisplayStatusBar
''//Get the statusbar display setting
Application.DisplayStatusBar = True
''//Make sure that the statusbar is visible
For i = 1 To iMax ''// imax is usually 30 or so
fractionDone = CDbl(i) / CDbl(iMax)
Application.StatusBar = Format(fractionDone, "0%") & " done..."
''// or, alternatively:
''// statusRange.value = Format(fractionDone, "0%") & " done..."
''// Some code.......
DoEvents
''//Yield Control
Next i
Application.DisplayStatusBar = booStatusBarState
''//Reset Status bar display setting
Application.StatusBar = False
''//Return control of the Status bar to Excel
Application.ScreenUpdating = True
''//Turn on screen updating
End Sub
Text boxes in worksheets are sometimes not updated
when their text or formatting is changed, and even
the DoEvent command does not help.
As there is no command in Excel to refresh a worksheet
in the way a user form can be refreshed, it is necessary
to use a trick to force Excel to update the screen.
The following commands seem to do the trick:
- ActiveSheet.Calculate
- ActiveWindow.SmallScroll
- Application.WindowState = Application.WindowState
Put a call to DoEvents in the loop.
This will affect performance, so you might want to only call it on each, say, 10th iteration.
However, if you only have 30, that's hardly an issue.
#Hubisans comment worked best for me.
ActiveWindow.SmallScroll down:=1
ActiveWindow.SmallScroll up:=1
Specifically, if you are dealing with a UserForm, then you might try the Repaint method. You might encounter an issue with DoEvents if you are using event triggers in your form. For instance, any keys pressed while a function is running will be sent by DoEvents The keyboard input will be processed before the screen is updated, so if you are changing cells on a spreadsheet by holding down one of the arrow keys on the keyboard, then the cell change event will keep firing before the main function finishes.
A UserForm will not be refreshed in some cases, because DoEvents will fire the events; however, Repaint will update the UserForm and the user will see the changes on the screen even when another event immediately follows the previous event.
In the UserForm code it is as simple as:
Me.Repaint
This worked for me:
ActiveWindow.SmallScroll down:=0
or more simply:
ActiveWindow.SmallScroll 0
I couldn't gain yet the survey of an inherited extensive code. And exact this problem bugged me for months. Many approches with DoEnvents were not helpful.
Above answer helped. Placeing this Sub in meaningful positions in the code worked even in combination with progress bar
Sub ForceScreenUpdate()
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Wait Now + #12:00:01 AM#
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
This is not directly answering your question at all, but simply providing an alternative. I've found in the many long Excel calculations most of the time waiting is having Excel update values on the screen. If this is the case, you could insert the following code at the front of your sub:
Application.ScreenUpdating = False
Application.EnableEvents = False
and put this as the end
Application.ScreenUpdating = True
Application.EnableEvents = True
I've found that this often speeds up whatever code I'm working with so much that having to alert the user to the progress is unnecessary. It's just an idea for you to try, and its effectiveness is pretty dependent on your sheet and calculations.
On a UserForm two things worked for me:
I wanted a scrollbar in my form on the left. To do that, I first had to add an Arabic language to "Change administrative language" in the Language settings of Windows 10 (Settings->Time & Language->Change Administrative Language). The setting is actually for "Change the language of Non-Unicode Programs," which I changed to Arabic (Algerian). Then in the properties of the form I set the "Right to Left" property to True. From there the form still drew a partial ghost right scrollbar at first, so I also had to add an unusual timed message box:
Dim AckTime As Integer, InfoBox As Object
Set InfoBox = CreateObject("WScript.Shell")
'Set the message box to close after 10 seconds
AckTime = 1
Select Case InfoBox.Popup("Please wait.", AckTime, "This is your Message Box", 0)
Case 1, -1
End Select
I tried everything to get the screen to redraw again to show the first text box in it's proper alignment in the form, instead of partially underneath or at least immediately adjacent to the scrollbar instead of 4 pixels to the right where I wanted it. Finally I got this off another Stackoverflow post (which I now can't find or I would credit it) that worked like a charm:
Me.Frame1.Visible = False
Me.Frame1.Visible = True
In my case the problem was in trying to make one shape visible and another one invisible on a worksheet.
This is my approach to "inactivating" a button [shape] once the user has clicked it. The two shapes are the same size and in the same place, but the "inactive" version has dimmer colors, which was a good approach, but it didn't work, because I could never get the screen to update after changing .visible = FALSE to = TRUE and vice versa.
None of the relevant tricks in this thread worked. But today I found a solution that worked for me, at this link on Reddit
Essentially you just call DoEvents twice in immediate succession after the code that makes the changes. Now why? I can't say, but it did work.
I've been trying to solve this Force a screen update on a Worksheet (not a userform) for many years with limited success with
doevents and scrolling etc.. This CH Oldie solutions works best with a slight mod.
I took out the Wait and reset ScreenUpdating and EnableEvents back to true.
This works office excel 2002 through to office 365
Sub Sheet1Mess(Mess1 As String)
Sheet1.Range("A6").Value = Mess1
ForceScreenUpdate
End Sub
Sub ForceScreenUpdate()
Application.ScreenUpdating = True
Application.EnableEvents = True
' Application.Wait Now + #12:00:01 AM#
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
The code below is a function to move a worksheet in a workbook. It gets called from a userform that contains a listbox that lists the worksheets in the workbook. The input is an integer that gives the direction which to move the sheet. Left/right in workbook is up/down in the userform listbox, and the userform has up and down buttons that calls the function with different input (+1 for moving right and -2 for moving left).
This function sometimes gives the error Method 'Move' if object '_Worksheeet' failed, but not consistently. Mostly the error comes when moving a sheet a second time, so that I am not able to move a sheet more than once. Once the error occurs I am not able to move the sheet again. I can, however, select a different sheet and move this once before the same thing occurs.
If I implement a message box in the error handling, the behaviour changes. After closing the message box upon error, I can proceeed to move the same sheet again after an error. With a message box I can therefore move a sheet as many times as I want, but it only moves on every other button press. I guess the message box breaks code execution, which for some reason makes the function work again even one the same sheet that gave the error. I have tried replacing the message box with a delay or a selfclosing infobox but this does not give the same result.
To further complicate matters, sometimes when I open the userform application, the move buttons work perfectly without any error. I think this happens when the worksheet is already open before the application is opened.
It all seems very inconsistent, and beyond my knowledge. Any help or suggestions much appreciated.
Function FlyttMåling(Retning As Integer) As Boolean
Application.EnableEvents = False
Application.ScreenUpdating = False
'code to reference the correct workbook based on outside parameters
Dim wb As Workbook, ws As Worksheet
FlyttMåling = True
If Hovedvindu.LuftlydKnapp.Value = True Then
Set wb = ÅpneBok(1)
ElseIf Hovedvindu.TrinnlydKnapp.Value = True Then
Set wb = ÅpneBok(2)
End If
'sets variable to the index of sheet to be moved, chosen from list in userform
Dim nummer As Integer
Set ws = wb.Sheets(1)
If Hovedvindu.MålingerFrame.Liste.ListIndex < 0 Then
Exit Function
Else
Set ws = wb.Sheets(Hovedvindu.MålingerFrame.Liste.Value)
End If
nummer = ws.Index
'exit function if trying to move first sheet to the left or last sheet to the right
If (Retning = 1 And nummer = wb.Sheets.count) Or (Retning = -2 And nummer = 2) Then
Exit Function
End If
'code that moves worksheet
ws.Activate
On Error GoTo errHandler:
errResume:
ws.Move after:=wb.Sheets(nummer + Retning) 'THIS LINE CAUSES ERROR
On Error GoTo 0
Call oppdaterListe
'reselect the moved worksheet in the userform list
For i = 0 To Hovedvindu.MålingerFrame.Liste.ListCount - 1
If ws.Name = Hovedvindu.MålingerFrame.Liste.List(i) Then
Hovedvindu.MålingerFrame.Liste.Selected(i) = True
Exit For
End If
Next i
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Function
'error handling just sets the return to false to notify failure to move sheet
errHandler:
FlyttMåling = False
End Function
Found a workaround for this problmem. Changing the wb.move to a wb.copy, and then deleting the old sheet and renaming the copy to the name of the original sheet makes this code work as intended.
Before you go for the obvious: Application.DisplayAlerts = False has not solved my problem.
I have written a VBA procedure (initiated in Excel 2010) which loops around an array containing different Excel files. The loop opens the file, refreshes the data, saves and closes the file for each item in the array. I have written an error catch sub routine so I log which excel files have failed to open/refresh/save etc so a user can manually check them.
Some files are quite large and involve a large amount of data moving across the network; sometimes I get a dialog box with: Excel is waiting for another application to complete an OLE action.
I could use Application.DisplayAlerts = False to disable the message but this would presumably disable all alerts so I couldn't catch the errors?
Further I have tested using the line and it doesn't stop the dialog box pop-up. If I press enter it carries on but will likely pop-up again a few minutes later.
Is there a way to stop is message specifically without stopping other alerts?
NB. My process has a control instance of Excel which runs the VBA and opens the workbooks to be refreshed in a separate instance.
Thanks for your help
An extract of my code is below which contains the refresh elements
Sub Refresh_BoardPivots_Standard()
' On Error GoTo Errorhandler
Dim i
Dim errorText As String
Dim x
Dim objXL As Excel.Application
Set objXL = CreateObject("Excel.Application")
GetPivotsToRefresh ' populate array from SQL
For Each i In StandardBoardPiv
DoEvents
'If File_Exists(i) Then
If isFileOpen(i) = True Then
errorText = i
Failed(failedIndex) = errorText
failedIndex = failedIndex + 1
Else
objXL.Visible = True 'False
objXL.Workbooks.Open FileName:=i
If objXL.ActiveWorkbook.ReadOnly = False Then
BackgroundQuery = False
Application.DisplayAlerts = False
objXL.ActiveWorkbook.RefreshAll
objXL.Application.CalculateFull
objXL.Application.DisplayAlerts = False
objXL.ActiveWorkbook.Save
objXL.Application.DisplayAlerts = True
objXL.Quit
Else
errorText = i
Failed(failedIndex) = errorText
failedIndex = failedIndex + 1
objXL.Application.DisplayAlerts = False
objXL.Quit
Application.DisplayAlerts = True
End If
End If
' Else
' errorText = i
' Failed(failedIndex) = errorText
' failedIndex = failedIndex + 1
' End If
DoEvents
If Ref = False Then
Exit For
End If
Next i
Exit Sub
'Errorhandler:
'
'errorText = i
'Failed(failedIndex) = errorText
'failedIndex = failedIndex + 1
'Resume Next
End Sub
"Waiting for another application to complete an OLE action" isn't an alert message you can just turn off and forget, sometimes the macro will be able to continue on after, but in my experience if you are getting that error its only a matter of time until the problem crashes/freezes your whole macro so it should definitely be troubleshot and corrected.
I only get that error when I am using additional Microsoft Office Applications (other than the Excel that is running the code) as objects and one of them has an error- the Excel running the code doesn't know that an error occurred in one of the other applications so it waits and waits and waits and eventually you get the "Waiting for another application to complete an OLE action" message...
So to troubleshoot this sort of problem you got to look for the places you use other MSO apps... In your example, you have an additional instance of Excel and you are pulling data from Access, so its most likely one of those two that is causing the problems...
Below is how I would re-write this code, being more careful with where the code interacts with the other MSO apps, explicitly controlling what is happening in them.. The only piece I couldn't really do much is GetPivotsToRefresh because I cant see what exactly youre doing here, but in my code I just assumed it returned an array with a list of the excel files you want to update. See code below:
Sub Refresh_BoardPivots_Standard()
Dim pivotWB As Workbook
Dim fileList() As Variant
Dim fileCounter As Long
Application.DisplayAlerts = False
fileList = GetPivotsToRefresh 'populate array from SQL
For fileCounter = 1 To UBound(fileList, 1)
Set pivotWB = Workbooks.Open(fileList(fileCounter, 1), False, False)
If pivotWB.ReadOnly = False Then
Call refreshPivotTables(pivotWB)
pivotWB.Close (True)
Else
'... Error handler ...
pivotWB.Close (False)
End If
Next
End Sub
Public Sub refreshPivotTables(targetWB As Workbook)
Dim wsCounter As Long
Dim ptCounter As Long
For wsCounter = 1 To targetWB.Sheets.Count
With targetWB.Sheets(wsCounter)
If .PivotTables.Count > 0 Then
For ptCounter = 1 To .PivotTables.Count
.PivotTables(ptCounter).RefreshDataSourceValues
Next
.Calculate
End If
End With
Next
End Sub
So I created my own 'refreshPivotTables' but you could have embedded that into the master sub, I just thought the loops and loop counters might get a little messy at that point...
Hope this helps,
TheSilkCode
I'm creating a excel application that will be distributed to my associates. Based permissions I need to disable access to certain sheets and features. I've been able to protect and hide sheets but a savvy user is able to iterate over hidden worksheets internally or externally to expose data. I need to stop that.
Here's the process:
When the workbook opens a query to remote database is made to return set of user permissions. Then those permissions are printed to worksheet called "PERMISSIONS".
This code below iterates over worksheet permissions to find a particular setting by passing in column name.
CheckPerm "Timesheet"
Public Function CheckPerm(nPermColTarget As String) As Boolean
Dim Counter As Integer
Dim x As Integer
Dim y As Integer
Counter = 3
Do Until Sheet7.Cells(Counter, 1).Value = Associate_Name
Counter = Counter + 1
Loop
y = Counter
Counter = 2
Do Until Sheet7.Cells(2, Counter).Value = nPermColTarget
Counter = Counter + 1
Loop
x = Counter
If Sheet7.Cells(y, x).Value = "ON" Then
CheckPerm = True
GrntDenySheetAccess nPermColTarget, y, x, CheckPerm
Else
' "OFF"
CheckPerm = False
GrntDenySheetAccess nPermColTarget, y, x, CheckPerm
End If
End Function
Private Sub GrntDenySheetAccess(nPermColTarget As String, y As Integer, _
x As Integer, CheckPerm As Boolean)
Select Case nPermColTarget
' Sheet1
Case "Timesheet"
If CheckPerm = True Then
Sheet1.Unprotect "pass"
Sheet1.Visible = xlSheetVisible
End If
If CheckPerm = False Then
Sheet1.Protect "pass"
Sheet1.Visible = xlSheetVeryHidden
End If
End Select
End Sub
But even though sheet1 is hidden and protected, I can still iterate over hidden sheet1's content to access info. Anyway to stop that?
Thanks
There aren't any ways to safely protect access to anything in an Excel workbook. Passwords are much harder to crack in Excel versions 2007 and onward, but a user can simply save the workbook as a .xls file and then it becomes easy to crack.
The best you can do is to make it a little tougher for somebody to get into. Password protect your file, and set any sheets that you don't want them to get to to xlSheetVeryHidden, which prevents users from unhiding the sheets through the Excel user interface.
The commenters under your question are correct. If you want a secure application, Excel isn't the answer.
Having said that, if you enforce security in the database layer, Excel makes a great UI. Just make sure you don't store or retrieve data that the user shouldn't see.
My Excel tool performs a long task, and I'm trying to be kind to the user by providing a progress report in the status bar, or in some cell in the sheet, as shown below. But the screen doesn't refresh, or stops refreshing at some point (e.g. 33%). The task eventually completes but the progress bar is useless.
What can I do to force a screen update?
For i=1 to imax ' imax is usually 30 or so
fractionDone=cdbl(i)/cdbl(imax)
Application.StatusBar = Format(fractionDone, "0%") & "done..."
' or, alternatively:
' statusRange.value = Format(fractionDone, "0%") & "done..."
' Some code.......
Next i
I'm using Excel 2003.
Add a DoEvents function inside the loop, see below.
You may also want to ensure that the Status bar is visible to the user and reset it when your code completes.
Sub ProgressMeter()
Dim booStatusBarState As Boolean
Dim iMax As Integer
Dim i As Integer
iMax = 10000
Application.ScreenUpdating = False
''//Turn off screen updating
booStatusBarState = Application.DisplayStatusBar
''//Get the statusbar display setting
Application.DisplayStatusBar = True
''//Make sure that the statusbar is visible
For i = 1 To iMax ''// imax is usually 30 or so
fractionDone = CDbl(i) / CDbl(iMax)
Application.StatusBar = Format(fractionDone, "0%") & " done..."
''// or, alternatively:
''// statusRange.value = Format(fractionDone, "0%") & " done..."
''// Some code.......
DoEvents
''//Yield Control
Next i
Application.DisplayStatusBar = booStatusBarState
''//Reset Status bar display setting
Application.StatusBar = False
''//Return control of the Status bar to Excel
Application.ScreenUpdating = True
''//Turn on screen updating
End Sub
Text boxes in worksheets are sometimes not updated
when their text or formatting is changed, and even
the DoEvent command does not help.
As there is no command in Excel to refresh a worksheet
in the way a user form can be refreshed, it is necessary
to use a trick to force Excel to update the screen.
The following commands seem to do the trick:
- ActiveSheet.Calculate
- ActiveWindow.SmallScroll
- Application.WindowState = Application.WindowState
Put a call to DoEvents in the loop.
This will affect performance, so you might want to only call it on each, say, 10th iteration.
However, if you only have 30, that's hardly an issue.
#Hubisans comment worked best for me.
ActiveWindow.SmallScroll down:=1
ActiveWindow.SmallScroll up:=1
Specifically, if you are dealing with a UserForm, then you might try the Repaint method. You might encounter an issue with DoEvents if you are using event triggers in your form. For instance, any keys pressed while a function is running will be sent by DoEvents The keyboard input will be processed before the screen is updated, so if you are changing cells on a spreadsheet by holding down one of the arrow keys on the keyboard, then the cell change event will keep firing before the main function finishes.
A UserForm will not be refreshed in some cases, because DoEvents will fire the events; however, Repaint will update the UserForm and the user will see the changes on the screen even when another event immediately follows the previous event.
In the UserForm code it is as simple as:
Me.Repaint
This worked for me:
ActiveWindow.SmallScroll down:=0
or more simply:
ActiveWindow.SmallScroll 0
I couldn't gain yet the survey of an inherited extensive code. And exact this problem bugged me for months. Many approches with DoEnvents were not helpful.
Above answer helped. Placeing this Sub in meaningful positions in the code worked even in combination with progress bar
Sub ForceScreenUpdate()
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Wait Now + #12:00:01 AM#
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
This is not directly answering your question at all, but simply providing an alternative. I've found in the many long Excel calculations most of the time waiting is having Excel update values on the screen. If this is the case, you could insert the following code at the front of your sub:
Application.ScreenUpdating = False
Application.EnableEvents = False
and put this as the end
Application.ScreenUpdating = True
Application.EnableEvents = True
I've found that this often speeds up whatever code I'm working with so much that having to alert the user to the progress is unnecessary. It's just an idea for you to try, and its effectiveness is pretty dependent on your sheet and calculations.
On a UserForm two things worked for me:
I wanted a scrollbar in my form on the left. To do that, I first had to add an Arabic language to "Change administrative language" in the Language settings of Windows 10 (Settings->Time & Language->Change Administrative Language). The setting is actually for "Change the language of Non-Unicode Programs," which I changed to Arabic (Algerian). Then in the properties of the form I set the "Right to Left" property to True. From there the form still drew a partial ghost right scrollbar at first, so I also had to add an unusual timed message box:
Dim AckTime As Integer, InfoBox As Object
Set InfoBox = CreateObject("WScript.Shell")
'Set the message box to close after 10 seconds
AckTime = 1
Select Case InfoBox.Popup("Please wait.", AckTime, "This is your Message Box", 0)
Case 1, -1
End Select
I tried everything to get the screen to redraw again to show the first text box in it's proper alignment in the form, instead of partially underneath or at least immediately adjacent to the scrollbar instead of 4 pixels to the right where I wanted it. Finally I got this off another Stackoverflow post (which I now can't find or I would credit it) that worked like a charm:
Me.Frame1.Visible = False
Me.Frame1.Visible = True
In my case the problem was in trying to make one shape visible and another one invisible on a worksheet.
This is my approach to "inactivating" a button [shape] once the user has clicked it. The two shapes are the same size and in the same place, but the "inactive" version has dimmer colors, which was a good approach, but it didn't work, because I could never get the screen to update after changing .visible = FALSE to = TRUE and vice versa.
None of the relevant tricks in this thread worked. But today I found a solution that worked for me, at this link on Reddit
Essentially you just call DoEvents twice in immediate succession after the code that makes the changes. Now why? I can't say, but it did work.
I've been trying to solve this Force a screen update on a Worksheet (not a userform) for many years with limited success with
doevents and scrolling etc.. This CH Oldie solutions works best with a slight mod.
I took out the Wait and reset ScreenUpdating and EnableEvents back to true.
This works office excel 2002 through to office 365
Sub Sheet1Mess(Mess1 As String)
Sheet1.Range("A6").Value = Mess1
ForceScreenUpdate
End Sub
Sub ForceScreenUpdate()
Application.ScreenUpdating = True
Application.EnableEvents = True
' Application.Wait Now + #12:00:01 AM#
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub