In one of my workbooks I use both the Worksheet_Activate() trigger and also the Workbook_SheetActivate trigger. I'm using the latter as an over riding handler to control which users can see which worksheets. Using the following:
Private Sub Workbook_SheetActivate(ByVal ws As Object)
Dim HigherAccess As String
HigherAccess = "Sheet1, Sheet2, Sheet3"
If InStr(1, HigherAccess, ws.Name, vbTextCompare) > 0 Then
If UserList.Count = 0 Or ThisUser = "" Then Call UserDL
Application.EnableEvents = True
On Error GoTo err
If Not UserList.item(ThisUser)(7) = "Employee" Then
ThisWorkbook.Sheets(ws.Name).Activate
Else
ThisWorkbook.Sheets("Landing Page").Activate
MsgBox "You do not have permission to view this." & vbNewLine _
& "If this is an error please contact xxxx"
End If
End If
Exit Sub
err:
MsgBox "An Error has occurred. The application will now refresh"
ThisWorkbook.Sheets("Landing Page").Activate
End Sub
My issue is is that the Worksheet_Acivate() trigger seems to fire before the Workbook_SheetActivate one. Is there anyway to change the order in which these fire?
As Events are fired from the "smallest" object (in the Excel Object Model) to the "largest" object (worksheet to application), you cannot change the order of the events fired.
You can, however, work within that order to accomplish your goals, as #MacroMan has stated with his example of testing the Worksheet that caused the Change Event in the Workbook_SheetChange event.
See Chuck Pearson's tutorial on Events for more information.
Related
I will try to be as clear as possible in the description, so here goes nothing:
I have created a code in which the user selects his excel file and then the macro copies the Sheet from that file into my macro Workbook.
MyFile = Application.GetOpenFilename()
Workbooks.Open (MyFile)
ActiveSheet.Copy After:=wbook.Sheets(1)
ActiveSheet.Name = "Selected file"
Workbooks.Open (MyFile)
ActiveWorkbook.Close SaveChanges:=False
This is working, but what I realized is, that there might be cases where the selected file has multiple Sheets.
Is there a way to write the macro in which if my selected file has 1 sheet it runs the above code and if it has more than one sheet to let me select the sheet I want and then run the rest of the code?
Edit:
I thought of another way to handle this — perhaps closer to what you were looking for . . .
It's just an expansion of the basic pause routine that I use occasionally.
This is my "regular" Pause routine (using the Timer function):
Sub Pause(seconds As Single)
Dim startTime As Single
startTime = Timer 'get current timer count
Do
DoEvents 'let Windows "catch up"
Loop Until Timer > startTime + seconds 'repeat until time's up
End Sub
...so, it gave me an idea.
Honestly, I was a little surprised to discover that this works, since it's basically running two sections of code simultaneously.
Code for WaitForUserActivity :
Here's the code I used in the demo above:
Option Explicit
Public isPaused As Boolean
Sub WaitForUserActivity() 'THE 'RUN DEMO' BUTTON runs this sub.
Dim origSheet As String
isPaused = True 'flag "pause mode" as "on"
origSheet = ActiveSheet.Name 'remember current worksheet name
MsgBox "This will 'pause' code execution until you" & vbLf & _
"click the 'Continue' button, or select a different a worksheet."
Application.StatusBar = "PAUSED: Click ""Continue"", or select a worksheet."
Do 'wait for button click or ws change
DoEvents 'yield execution so that the OS can process other events
Loop Until (Not isPaused) Or (ActiveSheet.Name <> origSheet)
If isPaused Then 'the active worksheet was changed
MsgBox "Worksheet '" & ActiveSheet.Name & "' was selected." _
& vbLf & vbLf & "Now the program can continue..."
Else 'the button was clicked
MsgBox "The 'Continue' button was clicked." _
& vbLf & vbLf & "Now the program can continue..."
End If
Application.StatusBar = "Ready"
End Sub
Sub btnContinue() 'THE 'CONTINUE' BUTTON runs this sub.
isPaused = False 'flag "pause mode" as "off"
End Sub
To run the demo:
place the above code in a regular module
make sure the workbook has at least two worksheets
create two command buttons:
one for the "Run Demo" button, assign macro: WaitForUserActivity
one for the "Continue" button, assign macro: btnContinue
click the "Run Demo" button
The key command in the code is the DoEvents Function, which "yields execution so that the operating system can process other events."
DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent.
DoEvents is most useful for simple things like allowing a user to cancel a process after it has started, for example a search for a file. For long-running processes, yielding the processor is better accomplished by using a Timer or delegating the task to an ActiveX EXE component - and the operating system takes care of multitasking and time slicing.
Any time you temporarily yield the processor within an event procedure, make sure the procedure is not executed again from a different part of your code before the first call returns; this could cause unpredictable results.
Further details (and warnings) at the source.
Original Answer:
Some suggested solutions:
Instead of "stopping" the code you could prompt the user to specify which worksheet.
The easiest way would be with an InputBox where the user would enter an ID number or otherwise identify the worksheet.
More complicated but more robust and professional-looking would be a custom dialog box with the help of a userform. There are several examples and tutorials online such as this one.
You could "pause" execution to give the user a set amount of time to select a worksheet, with a simple timer loop, ad you could even check the worksheet name to see if the user picked a new one, something like this:
Dim startTime As Single, shtName As String
If ThisWorkbook.Worksheets.Count = 1 Then
MsgBox "There is only one worksheet in this workbook."
Else
shtName = ActiveSheet.Name 'get name of active sheet
MsgBox "You have 5 seconds to select a worksheet after clicking OK.", _
vbOKOnly + vbInformation, "Select a worksheet... fast!"
startTime = Timer
Do
DoEvents
Loop Until Timer > startTime + 5
'check if user picked a new worksheet
If ActiveSheet.Name = shtName Then
MsgBox "You didn't select a new worksheet!"
Else
MsgBox "Thanks for selecting a new worksheet!"
End If
End If
It's a little hoakey but could work, especially if proper checks to make sure you've got the correct worksheet now.
I suppose you could create an worksheet event procedure that would run when a worksheet is activated, and checked a global variable to see if your "import procedure" was running, and if so, resume your code... but that would be messy and confusing and would require the code to exist in the workbook you're "importing".
Or, better than any of those would be to programmatically/logically determine which worksheet you need based on the contents of the worksheet. Is there a title? A certain date? Maybe the newest worksheet? Something in a certain cell? There must be something that differentiates it from the others.
Hopefully this gives you some ideas towards a non-linear solution. 😉
As in whole, I would recommend ashleedawg's solution, but if you
insisted on maintaining your code structure, your code could look
something like this:
You can distinguish between amount of Sheets a Workbook has using .Count property of the Sheets object (or Worksheets if you do not want to include Charts) and use InputBox to check for the sheet you want to look for.
MyFile = Application.GetOpenFilename()
Workbooks.Open (MyFile)
If ThisWorkbook.Sheets.Count = 1 Then
ThisWorkbook.ActiveSheet.Copy After:=wbook.Sheets(1)
ThisWorkbook.ActiveSheet.Name = "Selected File"
Else
Dim checkfor As String
checkfor = InputBox("What Sheet should I execute the code for?")
Dim i As Integer
For i = 0 To ThisWorkbook.Sheets.Count
If Trim(LCase(checkfor)) = Trim(LCase(Sheets(i).Name))) Then
ThisWorkbook.Sheets(i).Copy After := wbook.Sheets(1)
ThisWorkbook.Sheets(i).Name = "Selected file"
End If
Next i
End If
Workbooks.Open (MyFile)
ActiveWorkbook.Close SaveChanges:=False
Might need some further tweaking, because I was unsure what exactly you wanted to achieve.
I have a workbook which works with lots of VBA and a custom add-in to create reports for customers. The workbook has a series of buttons on the front sheet, which control the operation of the report "app":
This is mostly deployed on Surface Pro 3s and 4s. One of the users reports that any time they click a button, it becomes pixellated (pictured below) and can no longer be read. I haven't seen this on other units, and it may be relevant that this user has an external display which duplicates what is on his Surface screen. The effect happens on both screens:
The office version is Excel 2016 MSO 32-bit.
Has anyone seen this and does anyone know why it happens?
I eventually solved this problem by replacing all of the buttons with Rectangle Shapes. These can still have macros assigned and even turn the cursor to a hand when the user hovers over them.
I think that the pixellation problem is peculiar to embedded ActiveX controls on worksheets, and it can be avoided by using other tools when possible. I don't think there's any other way!
To reimplement buttons as shapes, I wrote a ShapeButtons module (in VBA side) with some helpful functions for showing/hiding buttons and getting/setting text. All of the buttons in our worksheet are on a page called ControlSheet. Please excuse my highly defensive error handling:
Public Sub SetShapeBtnText(name As String, newText As String)
On Error GoTo errorHandler
Dim btn As Shape
Set btn = GetShapeBtn(name)
btn.TextFrame2.TextRange.text = newText
Exit Sub
errorHandler:
WriteDebugError ("SetShapeBtnText Exception for " & name & " with " & newText)
End Sub
Public Sub ShowShapeBtn(name As String)
On Error GoTo errorHandler
ControlSheet.Shapes(name).Visible = True
Exit Sub
errorHandler:
WriteDebugError ("ShowShapeBtn Exception for " & name)
End Sub
Public Sub HideShapeBtn(name As String)
On Error GoTo errorHandler
ControlSheet.Shapes(name).Visible = False
Exit Sub
errorHandler:
WriteDebugError ("HideShapeBtn Exception for " & name)
End Sub
Public Function ShapeBtnIsVisible(name As String) As Boolean
On Error GoTo errorHandler
ShapeBtnIsVisible = ControlSheet.Shapes(name).Visible
Exit Function
errorHandler:
WriteDebugError ("ShapeBtnIsVisible Exception for " & name)
End Function
I have a Worksheet, which updates the StatusBar based on which cell is selected (this works fine). My problem is, with the code that sets the StatusBar back to empty when the user goes to another Worksheet:
Private Sub Worksheet_Deactivate()
Application.StatusBar = vbNullString ' Run time error here
End Sub
Err.Description is: "Method 'StatusBar' of object '_Application' failed", Err.Number is: 50290.
This error occurs only if the user changes from Worksheet to Worksheet rapidly (by pressing Ctrl+PgUp or Ctrl+PgDown) and does not happen in case of switching to another Sheet slowly.
Why do I have this error?
Just set it to False
Application.StatusBar = False
from Microsoft:
This property returns False if Microsoft Excel has control of the status bar. To restore the default status bar text, set the property to False; this works even if the status bar is hidden.
I found the problem. When an event handler starts execution, the Excel Application may not be ready, so this has to be checked if the code refers to objects related to the Application:
Private Sub Worksheet_Activate()
If Application.Ready = False Then Exit Sub
' Rest of the code referring to Application.x or Me.y or ActiveSheet.z, etc.
End Sub
I use a VBA macro to query a database and build a list of available projects when a workbook is opened using the workbook activate event. I have project numbers and project names that are combined into two separate data validation lists and applied to two cells. The worksheet change event tests for changes in these cells, splits their data validation lists into arrays, and chooses the corresponding project information from the other array. For instance, if I pick a project number, the worksheet change event finds the project number's position in the project number array, and then picks the project's name from the name array based on position.
This works perfectly whenever a value is selected from the drop down, but I run into problems when values outside the list are entered. For instance, if I enter a blank cell I may get the data validation error or I may get a type mismatch when I use match to find the entered value in the array. I have an error handler to handle the type mismatch, but I would like the data validation error to trigger every time instead. Another problem is that Events will sometimes be disabled. This is much more serious because users will not have a way to turn these back on.
On top of this, I cannot figure out where or how this is happening. I can't replicate how the Events are disabled using breaks because duplicating the steps that lead to the events being disabled with breaks in place only leads to my error handler. However, when breaks aren't applied, the error handler will sometimes fail to trigger and the events will be disabled. Since I'm disabling events just before I parse arrays, I'm thinking the worksheet change fails at the Loc=Application.Match(Target.Text, NumArr, 0) - 1 line, but I can't figure out why no error would be triggered. At the very least, I should get a message with the error number and description, and events should be re-enabled.
Can anyone advise on the interaction between worksheet change and data validation? What is the call order here? Any other advice? Anything I'm missing?
ETA: I've Googled this, but I haven't found anything that helps. Everything that comes up is about working the data validation into worksheet change, nothing about the interaction or call order.
ETA #2: After trying the experiment in the answer below (Thanks Gary's Student), this gets a little more odd. If I choose "Retry" and choose the old, default value, I get the old value three times. If I hit delete, I get a space in the message box, but only one message box. Then the cell is left blank. I can put DV into a loop by clicking "Retry" and accepting the space. The DV error will come up until I click cancel. Then I will get a series of empty text message boxes, one for each time I retried the empty cell. If I start off with a listed value, clear the cell with backspace, click "Retry," and try to select another value, the worksheet change event fails at Intersect 3 times. I think the answer below sheds more light on what is going on, but it does bring up more questions also.
Here is the code I have:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NumArr() As String
Dim ProjArr() As String
Dim Loc As Integer
On Error GoTo ErrHandler:
If Target.Address = "$E$4" Then
'Disable events to prevent worksheet change trigger on cell upates
Application.EnableEvents = False
'Parse validation lists to arrays
NumArr = Split(Target.Validation.Formula1, ",")
ProjArr = Split(Target.Offset(1, 0).Validation.Formula1, ",")
'Change error handler
On Error GoTo SpaceHandler:
'Determine project number location in array
Loc = Application.Match(Target.Text, NumArr, 0) - 1
'Change error handler
On Error GoTo ErrHandler:
'Change cell value to corresponding project name based on array location
Target.Offset(1, 0) = ProjArr(Loc)
'Unlock cells to prepare for editing, reset any previously imported codes
Range("C8:G32").Locked = False
'Run revenue code import
RevenueCodeCollector.ImportRevenueCodes
'Re-enable events
Application.EnableEvents = True
End If
If Target.Address = "$E$5" Then
Application.EnableEvents = False
NumArr = Split(Target.Validation.Formula1, ",")
ProjArr = Split(Target.Offset(-1, 0).Validation.Formula1, ",")
Loc = Application.Match(Target.Text, NumArr, 0) - 1
Target.Offset(-1, 0) = ProjArr(Loc)
Range("C8:G32").Locked = False
RevenueCodeCollector.ImportRevenueCodes
Application.EnableEvents = True
End If
Exit Sub
ErrHandler:
MsgBox Err.Number & " " & Err.Description
Application.EnableEvents = True
Exit Sub
SpaceHandler:
MsgBox "Pick a project from the dropdown.", vbOKOnly, "Error"
Application.EnableEvents = True
End Sub
You have a very open-ended question...........not having the time to do a full whitepaper, here is a simple experiment. I use the Event code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A1 As Range, rINT As Range
Set A1 = Range("A1")
Set rINT = Intersect(A1, Target)
If rINT Is Nothing Then Exit Sub
MsgBox A1.Value
End Sub
and in A1, I setup DV as follows:
If I use the drop-down, I get the value entered and I also get the MsgBox. However, if I click on the cell and type some junk what happens is:
the DV alert occurs and I touch the CANCEL Button
I get 2 MsgBox occurrences, each with the original contents rather than the attempted junk !!
I have absolutely no idea why the event is raised since the cell is not actually changed, let alone why the Event is raised twice !! It is almost as if
the event is raised on junk entry, but the DV alarm has precedence, the DV reverse the entry and another event is raised, and finally both events get processed.
Hopefully a person smarter than me will chime in.
With ref to the query, Workaround for the DV and change event is managed.
Public strRange As String
Public bCheck As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If bCheck Then Exit Sub
MsgBox "Correct Entry!"
strRange = Target.Address
bCheck = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> strRange Then bCheck = False
End Sub
http://forum.chandoo.org/threads/multiple-worksheet-change-event-with-data-validation.32750
I have to run a set of code related to worksheet "wins", but only if that worksheet exist.
Please share a code to check the availability of sheet "wins". If worksheet "wins" exist, then only I want to run that set of code, else I want to skip executing that set of code and move to next line of code.
You could use On Error Resume Next to skip the errror which occurs if you try access a not existing worksheet and assigning it to a object variable. So if the worksheet does not exist, no error occurs but the variable is Nothing. If the worksheet exists, then the variable is not Nothing.
Example:
Sub test()
Dim wsWins As Worksheet
On Error Resume Next
Set wsWins = ActiveWorkbook.Worksheets("wins")
On Error GoTo 0
If Not wsWins Is Nothing Then
MsgBox "Worksheet wins exists."
Else
MsgBox "Worksheet wins does not exist."
End If
End Sub
Axel's answer will work nicely. Some people prefer not to use error throwing to test if something exists. If you're one of them then I use the following quite a lot in a Utility module. It'll work for Worksheets, Charts, etc. (basically anything that's a collection with a 'Name' property):
Public Function ExcelObjectExists(testName As String, excelCollection As Object) As Boolean
Dim item As Object
On Error GoTo InvalidObject
For Each item In excelCollection
If item.Name = testName Then
ExcelObjectExists = True
Exit Function
End If
Next
ExcelObjectExists = False
Exit Function
InvalidObject:
MsgBox "Developer error: invalid collection object passed in ExcelObjectExists."
ExcelObjectExists = False
End Function
You can call it like this:
If ExcelObjectExists("wins", ThisWorkbook.Worksheets) Then