I want to run a simple script which I would further enhance. I had something similar working for autofilters yesterday but I misplaced it and am having a hard time to find a solution. I want to use an active x textbox to filter a pivot table. I have tried changing the location of the module as well as using acitveworkbook and activesheet and me but all seem to return a 1004 error. I can confirm the textbox is on the page as well as the pivot table. This is office 13.
Private Sub TextBox1_Change()
ActiveSheet.PivotTables("PivotTable2").PivotFields("Agency").ClearAllFilters
ActiveSheet.PivotTables("PivotTable2").PivotFields("Agency").CurrentPage = ActiveSheet.TextBox1.Text
End Sub
I believe the solution I had yesterday had something to do with activating the textbox. But cant quite rememeber.
Any help would be much appreciated.
Your subroutine must be placed in the Worksheet's code module. I believe the error is happening because the _Change event fires with every keystroke, so it is very likely that the first keystroke creates a TextBox1.Text value which does not correspond with any of the PivotItems in that PivotField.
You could do something like this. Use the _GotFocus event to provide an input prompt. That subroutine will then implicitly raise the TextBox1_Change event by assigning the input value to the TextBox1.Text.
Private Sub TextBox1_GotFocus()
Dim str$
str = InputBox("Please enter a value", "Pivot Field filter")
TextBox1.Text = str
End Sub
I temporarily disable error handling (On Error Resume Next) to assign the filter. Then I check to see if an error happened, and you can (optionally) inform the user that they supplied an invalid criteria.
Sub TextBox1_Change()
Dim pt As PivotTable
Dim fld As PivotField
Set pt = PivotTables("PivotTable2") 'Modify as needed
Set fld = pt.PivotFields("Agency")
With fld
.ClearAllFilters
On Error Resume Next
.CurrentPage = TextBox1.Text
.Orientation = xlPageField
.Position = 1
If Err.Number <> 0 Then
'you may want to include a prompt here, i.e.:
MsgBox "Invalid Filter!", vbInformation
Exit Sub
End If
On Error GoTo 0
End With
End Sub
Related
I am trying to automatically change the filtered range in a multiple pivot tables to a desired four week range at the same time instead of having to manually filter them all.
The Weeks are defined by week numbers 1-52 and not as dates. I have been unable to get any version of code to work on an individual pivot table and have not attempted to write the VBA to affect multiple tables at once.
Example of pivot table and 4 week range set up
Here is the last attempt. It resulted in
Run-time error '1004': Application-defined or object-defined error
highlighting the last line of code.
Sub Updateweekrange1()
If Range("T2").Value = "" Then
MsgBox ("You Must First Enter a Beginning Week#.")
Exit Sub
End If
If Range("V2").Value = "" Then
MsgBox ("You Must First Enter a Ending Week#.")
Exit Sub
End If
With ActiveSheet.PivotTables("Test2").PivotFields("Week")
.ClearAllFilters
.PivotFilters.Add Type:=xlValueIsBetween, DataField:=ActiveSheet.PivotTables("Test2").PivotFields("Week"), Value1:=Range("T2").Value, Value2:=Range("V2").Value
End With
End Sub
I tested the below and it worked for me.
I solved this by recording a macro (via the initially hidden developer tab), whilst I set a between filter on the Week column and then examined the generated code.
Setting wsPivot to ActiveSheet or perhaps Sheets("Sheet1") for example can allow a bit more flexibility in our coding. I'm autistic; so I can sometimes appear to be schooling others, when I'm only trying to help.
Option Explicit
Private Sub Updateweekrange1()
Dim wsPivot As Worksheet
Set wsPivot = ActiveSheet
If wsPivot.Range("T2").Value = "" Then
MsgBox ("You Must First Enter a Beginning Week#.")
Exit Sub
End If
If wsPivot.Range("V2").Value = "" Then
MsgBox ("You Must First Enter a Ending Week#.")
Exit Sub
End If
With wsPivot.PivotTables("Test2").PivotFields("Week")
.ClearAllFilters
.PivotFilters.Add2 _
Type:=xlValueIsBetween, DataField:=wsPivot.PivotTables("Test2"). _
PivotFields("Sum of Cost"), Value1:=wsPivot.Range("T2").Value, Value2:=wsPivot.Range("V2").Value
End With
End Sub
I have a macro which runs through several pivot tables. In this one if the option isn't available e.g. I'm trying to select the number 50, but that isn't in the pivot table data. I want it to select blank instead.
I've done an On error GoTo This works when the code is not there, but if the code IS there it acts like it isn't and returns blank values in the filter. Can anyone tell what I've done wrong here?
Sub SelectPromoter()
Dim a As String
Dim pt As PivotTable
On Error GoTo Other
ThisWorkbook.Worksheets("New Account Details - Name").Activate
a = Worksheets("Selection").Cells(3, 1).Value
For Each pt In ActiveSheet.PivotTables
With pt.PivotFields("Promoter code")
.ClearAllFilters
.CurrentPage = a
End With
Other:
ActiveSheet.PivotTables("PivotTable4").PivotFields("Promotor code").CurrentPage = "(blank)"
' Select here to add any other key filters for the pivot table using fixed criteria
ActiveSheet.PivotTables("PivotTable4").PivotFields("Milvus Account Name Change?").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Milvus Account Name Change?").CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Milvus Account Name Change?")
.PivotItems("N").Visible = False
End With
Next
End Sub
If I understand your problem statement correctly, this will fix it:
Sub SelectPromoter()
Dim wsAccountDetails As Worksheet
Set wsAccountDetails = ThisWorkbook.Worksheets("New Account Details - Name")
Dim a As String
a = Worksheets("Selection").Cells(3, 1).Value
On Error GoTo Data_NotFound
Dim pt As PivotTable
For Each pt In wsAccountDetails.PivotTables
With pt.PivotFields("Promoter code")
.ClearAllFilters
.CurrentPage = a
End With
GoTo Data_Found
Data_NotFound:
ActiveSheet.PivotTables("PivotTable4").PivotFields("Promotor code").CurrentPage = "(blank)"
Data_Found:
With wsAccountDetails
.PivotTables("PivotTable4").PivotFields("Milvus Account Name Change?").ClearAllFilters
.PivotTables("PivotTable4").PivotFields("Milvus Account Name Change?").CurrentPage = "(All)"
.PivotTables("PivotTable4").PivotFields("Milvus Account Name Change?").PivotItems("N").Visible = False
End With
Next pt
End Sub
The relevant line here is GoTo Data_Found. If you don't include that line, the code under the label Other: will be executed regardless of if an error occurs or not. That's why you need to "jump over it". GoTo-labels are not if-statements, which means they have no direct impact on control flow, you have to implement that logic manually by using GoTo. Although GoTo-statements aren't considered best practice, they do have some (if very few) genuine use cases. You can read more on how they work here.
I'm not used to working with pivot tables, but I assume there's a way to check if a certain value is available. Handling these situations properly is preferable to simply letting errors be thrown and catching them, as you won't notice different errors when they occur. If you decide to stick to this approach, you should at least constrain it as much as possible:
Sub SelectPromoter()
Dim wsAccountDetails As Worksheet
Set wsAccountDetails = ThisWorkbook.Worksheets("New Account Details - Name")
Dim a As String
a = Worksheets("Selection").Cells(3, 1).Value
Dim pt As PivotTable
For Each pt In wsAccountDetails.PivotTables
On Error GoTo Data_NotFound
With pt.PivotFields("Promoter code")
.ClearAllFilters
.CurrentPage = a
End With
On Error GoTo 0
GoTo Data_Found
Data_NotFound:
ActiveSheet.PivotTables("PivotTable4").PivotFields("Promotor code").CurrentPage = "(blank)"
Data_Found:
With wsAccountDetails
.PivotTables("PivotTable4").PivotFields("Milvus Account Name Change?").ClearAllFilters
.PivotTables("PivotTable4").PivotFields("Milvus Account Name Change?").CurrentPage = "(All)"
.PivotTables("PivotTable4").PivotFields("Milvus Account Name Change?").PivotItems("N").Visible = False
End With
Next
End Sub
Please take a look at where I moved the lines regarding the error handling On Error ....
Please also take a look at How to avoid using Select in Excel VBA. You should generally avoid using .Select and .Activate as it's inefficient and error-prone. I provided a better approach with the code, namely using a Worksheet object to address the sheet directly.
If I understand your question correctly, problem is as your code is written, section below Other: will execute always and you want when no error occures the code should stop just before it right?
Solution is in this case simple - add before it Exit sub. So code below other will execute only when send by error handle
I am also VBA noob but generally Error handlers are written at the end of code and "normal" code is ended with Exit sub.
I have this code but it only work for my first row.
It is suppose to look if the checkbox on B, C or D is checked, and if so, a date + username will automaticaly fill in F and G.
here is a picture of my table:
This is what my code looks like:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("B2") Or Range("C2") Or Range("D2") = True Then
Range("G2").Value = Environ("Username")
Range("F2").Value = Date
Else
Range("F2:G2").ClearContents
End If
End Sub
Enter this code in a regular module, select all your checkboxes and right-click >> assign macro then choose ReviewRows.
This will run the check whenever a checkbox is clicked - a bit of overhead since all rows will be checked, but should not be a big deal.
Sub ReviewRows()
Dim n As Long
For n = 1 To 100 'for example
With Sheet1.Rows(n)
If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
.Cells(6) = Date
.Cells(7) = Environ("Username")
End If
Else
.Cells(6).Resize(1, 2).ClearContents
End If
End With
Next n
End Sub
If you want to be more precise then Application.Caller will give you the name of the checkbox which was clicked, and you can use that to find the appropriate row to check via the linkedCell.
Sub ReviewRows()
Dim n As Long, shp As CheckBox, c As Range, ws As Worksheet
Set ws = ActiveSheet
On Error Resume Next 'ignore error in case calling object is not a checkbox
Set shp = ActiveSheet.CheckBoxes(Application.Caller) 'get the clicked checkbox
On Error GoTo 0 'stop ignoring errors
If Not shp Is Nothing Then 'got a checkbox ?
If shp.LinkedCell <> "" Then 'does it have a linked cell ?
With ws.Range(shp.LinkedCell).EntireRow
If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
.Cells(6) = Date
.Cells(7) = Environ("Username")
End If
Else
.Cells(6).Resize(1, 2).ClearContents
End If
End With
End If 'has linked cell
End If 'was a checkbox
End Sub
However this appraoch is sensitive to the exact positioning of your checkbox
You have a long way to go!
Unfortunately, If Range("B2") Or Range("C2") Or Range("D2") = True Then is beyond repair. In fact, your entire concept is.
Start with the concept: Technically speaking, checkboxes aren't on the worksheet. They are on a layer that is superimposed over the worksheet. They don't cause a worksheet event, nor are they responding to worksheet events. The good thing is that they have their own.
If Range("B2") Or Range("C2") Or Range("D2") = True Then conflates Range with Range.Value. One is an object (the cell), the other one of the object's properties. So, to insert sense into your syntax it would have to read, like, If Range("B2").Value = True Or Range("C2").Value = True Or Range("D2").Value = True Then. However this won't work because the trigger is wrong. The Worksheet_Change event won't fire when when a checkbox changes a cell's value, and the SelectionChange event is far too common to let it run indiscriminately in the hope of sometimes being right (like the broken clock that shows the correct time twice a day).
The answer, therefore is to capture the checkbox's click event.
Private Sub CheckBox1_Click()
If CheckBox1.Value = vbTrue Then
MsgBox "Clicked"
End If
End Sub
Whatever you want to do when the checkbox is checked must be done where it now shows a MsgBox. You can also take action when it is being unchecked.
This question already has an answer here:
Excel Find a sheet based on name
(1 answer)
Closed 8 years ago.
I have an excel workbook with a lot of sheet tabs, and to make navigating it easier for user's I've added a macro to bring up an input box so that they can type in the sheet they want to go to.
It works but the problem is that if they type in a sheet name incorrectly it does nothing, the input box goes away, and the user is left on the same sheet they were already on. What I would like it to do is if a user types in a sheet name that doesn't exist for it to bring up a box with a list of all the tabs and allow them to choose from the list. Barring that, at least a message box informing them they entered a non-existent sheet name and to try again, and to then go back to the input box rather than it disappearing. Here's the code I've been working with so far-
If that's not possible, I'd rather have it just bring up a list of available sheets in the first place and forget the input box altogether. My thought was that it would be nice to type in the needed sheet rather than having to sort through the list every time, but it'd be preferable to nothing happening.
Sub GotoSheet()
Dim sSheet As String
sSheet = InputBox( _
Prompt:="Sheet name or number?", _
Title:="Input Sheet")
On Error Resume Next
If Val(sSheet) > 0 Then
Worksheets(Val(sSheet)).Activate
Else
Worksheets(sSheet).Activate
End If
End Sub
If you would like a list of available sheets to pop up so you can choose one just make a quick UserForm, insert a ListBox (a ComboBox would work as well, I prefer a ListBox visually), and have it populate on userform_initialize:
Private Sub UserForm_Initialize()
Dim WS As Worksheet
For Each WS In Worksheets
ListBox1.AddItem WS.Name
Next WS
End Sub
Make sure the MultiSelect property is set to 0 for single select then create an ok button that goes to the selected sheet:
Private Sub CommandButton1_Click()
Sheets(ListBox1.Value).Activate
Unload Me
End Sub
Then create a button or whatever to show the form.
I believe the root of your problem at the moment is On Error Resume Next. This is causing the sub to simply exit when your else statement encounters an error, such as the sheet does not exist. Instead you need to handle that error through the use of something like On Error GoTo. As in:
Sub GotoSheet()
Dim sSheet As String
sSheet = InputBox( _
Prompt:="Sheet name or number?", _
Title:="Input Sheet")
On Error GoTo noSheet
If Val(sSheet) > 0 Then
Worksheets(Val(sSheet)).Activate
Exit Sub
Else
Worksheets(sSheet).Activate
Exit Sub
End If
noSheet:
'Enter your code to display a warning that the sheet does not exist
'and/or bring up a selection box of all sheets
End Sub
Here is some more information on the On Error statement, which may be of use: https://msdn.microsoft.com/en-us/library/aa266173%28v=vs.60%29.aspx
This will do it for you and handles all error without the need to use On Error statement.
Function Validate(SheetName As String) As Boolean
For i = 1 To ThisWorkbook.Worksheets.Count
If SheetName = ThisWorkbook.Worksheets(i).Name Then
Validate = True
Exit Function
Else
Validate = False
End If
Next
End Function
Sub GotoSheet()
Dim sSheet As String
sSheet = InputBox( _
Prompt:="Sheet name or number?", _
Title:="Input Sheet")
Do While Validate(sSheet) = False
'This if statement is true when the user click cancel or x button
If sSheet = "" Then
Exit Do
End If
MsgBox (sSheet & " does not exist. Please enter a valid sheet name.")
sSheet = InputBox( _
Prompt:="Sheet name or number?", _
Title:="Input Sheet")
Loop
If sSheet <> "" Then
Worksheets(sSheet).Activate
End If
End Sub
I have been trying to fix a login problem but I cannot find a solution. When both login and pass fail, an error message starts a countdown without letting the user manifest another opinion.
QUESTION 1: Can anyone please make the necessary corrections without altering too much the given code structure and explain?
QUESTION 2: What code would turn the "User1" text into bold at the moment the access is granted?
QUESTION 3: What command would disable the "X" on the top right-hand corner of the msg form?
Thank you in advance
Here it is what I could do
¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨
Private Sub BtOK_Click()
Dim User1 As String
Dim count As Integer
count = 3
MM:
If EDBoxlogin.Value = "admin" And EDBoxpass.Value = "1234" Then
User1 = Application.UserName
MsgBox "welcome" & User1 & " !", vbExclamation, "Access Granted"
Sheets("Plan1").Visible = xlSheetVisible
Unload Me
Else
If EDBoxlogin.Value = "" Or EDBoxpass.Value = "" Then
MsgBox "Please, fill in the fiels 'login' and 'pass'", vbExclamation + vbOKOnly, "Access denied : incomplete information"
Else
If count >= 0 Then
MsgBox "Login and pass are incorrect! You have " & count & " more trial(s)", vbExclamation + vbOKOnly, "Access denied"
EDBoxlogin.Value = "" And EDBoxpass.Value = ""
' I want to delete previous text in the editbox fields
count = count - 1
GoTo MM
Else
ThisWorkbook.Close
End If
End If
End If
End Sub
If you don't really need to know which user is opening the workbook, consider using Excel's built-in password security function. Also, you should encrypt the contents of the file also using Excel's built-in functions, or anyone can open the file with a text editor and find the userID and password listed in your code.
If you must use a login form, and I've also had to do so in the past, the following code builds on what you did by adding a user list to a hidden worksheet Users. Column A in that sheet needs to be the user names, B contains the passwords. This worksheet also uses cell D1 to track failed login attempts. Using variables in code for this sort of thing is tough ... you have to make them Public and if there are any errors when running code, it will lose its value, then bad things can happen.
The code also references another sheet, SplashPage. This allows you to hide Project1 when the user exits the workbook. The code I wrote handles the hide/unhide process when the file is opened or closed.
I don't know a way to turn off the close box in a user form. I've added code to reject the login if a user does that.
Happy coding.
'Module: frmLogin
Private Sub BtOK_Click()
Dim User1 As String
Dim Passwd As Variant
Sheets("Users").Range("D2").Value = False
User1 = EDBoxlogin.Value
Passwd = getPassword(User1)
If User1 <> "" And Passwd <> "" And EDBoxpass.Value = Passwd Then
Sheets("Users").Range("D2").Value = True
MsgBox "Welcome " & User1 & "!", vbExclamation, "Access Granted"
With Sheets("Plan1")
.Visible = xlSheetVisible
.Activate
End With
Sheets("SplashPage").Visible = xlSheetVeryHidden
Unload Me
Exit Sub
Else
Sheets("Users").Range("D1").Value = Sheets("Users").Range("D1").Value - 1
If Sheets("Users").Range("D1").Value > 0 Then
MsgBox "Login and pass are incorrect! You have " & Sheets("Users").Range("D1").Value & _
" more trial(s)", vbExclamation + vbOKOnly, "Access denied"
EDBoxpass.Value = ""
With EDBoxlogin
.Value = ""
.SetFocus
End With
' I want to delete previous text in the editbox fields
Exit Sub
End If
End If
UserForm_Terminate
End Sub
Private Sub UserForm_Terminate()
If Sheets("Users").Range("D2").Value <> True Then
MsgBox "Login cancelled, goodbye!"
doWorkbookClose
End If
End Sub
'Module: ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
doWorkbookClose
End Sub
Private Sub Workbook_Open()
On Error Resume Next
Sheets("Users").Range("D1").Value = 3
With Sheets("SplashPage")
.Visible = xlSheetVisible
.Activate
End With
Sheets("Plan1").Visible = xlSheetVeryHidden
Sheets("Users").Visible = xlSheetVeryHidden
ThisWorkbook.Save
frmLogin.Show
End Sub
'Module: Module1
Function getPassword(strVarib As String) As Variant
Dim r As Long
Dim sht As Worksheet
Dim rng As Range
On Error GoTo ErrorHandler
Set sht = Sheets("Users")
Set rng = sht.Range("A:A")
r = WorksheetFunction.Match(strVarib, rng, 0)
getPassword = sht.Cells(r, 2).Value
Exit Function
ErrorHandler:
getPassword = Empty
End Function
Sub doWorkbookClose()
On Error Resume Next
With Sheets("SplashPage")
.Visible = xlSheetVisible
.Activate
End With
Sheets("Plan1").Visible = xlSheetVeryHidden
Sheets("Users").Visible = xlSheetVeryHidden
ThisWorkbook.Save
End Sub
[begin Q&A]
Luiz, I've answered your edits below.
'Q: What Passwd does?
'Module: frmLogin
....
Passwd = getPassword(User1)
A: It gets the password value matching the value of User1. Here's the whole function for context:
Function getPassword(strVarib As String) As Variant
Dim r As Long
Dim sht As Worksheet
Dim rng As Range
On Error GoTo ErrorHandler
Set sht = Sheets("Users")
Set rng = sht.Range("A:A")
r = WorksheetFunction.Match(strVarib, rng, 0)
getPassword = sht.Cells(r, 2).Value
Exit Function
ErrorHandler:
getPassword = Empty
If User1 does not exist then WorksheetFunction.Match throws an error and code execution will jump to ErrorHandler:.
'Q: Does Empty mean that the cell is not with zeros or spaces, but completely blank instead?
A: Empty refers to a Variant variable type that is set to its default value. getPassword could just as easily return the boolean False or integer 0 because those are the default values for those types. It's actually not strictly necessary to set getPassword to anything here ... it's just my personal practice to be explicit.
Since IsEmpty(celFoo) is a valid test for whether a cell is empty or not, you might want to return False instead of Empty to avoid ambiguity.
'Q: Can you explain these two lines below in detail?
Set sht = Sheets("Users")
Set rng = sht.Range("A:A")
A: It's just habit. The alternative would be to elminate those variable assignments and rewrite this line:
r = WorksheetFunction.Match(strVarib, rng, 0)
as:
r = WorksheetFunction.Match(strVarib, Sheets("Users").Range("A:A"), 0)
which is messier to type. Especially if we're going to be doing other things on that sheet with that range in the same routine. Which we are in the next block of code ...
'Q: Important to explain these three lines below in detail too [why 0?, To where (r,2) points to?]
r = WorksheetFunction.Match(strVarib, rng, 0)
getPassword = sht.Cells(r, 2).Value
Exit Function
A: To review, worksheet Users contains user IDs in column A, and their passwords in column B. There can be as many users as there are rows in a worksheet.
- rng is column A as set above.
- 0 means find an exact match for strVarib and throw an error if not match is found.
- If we find a match, r will be set to the row number where the value in column A is equal to our input parameter, strVarib.
- So, sht.Cells(r, 2).Value is the password value in column B (column 2) for the UserID.
'Q: Why the need to call a splashpage? What it contains?
A: You don't necessarily need one, but if you really want to secure your workbook it's good practice. Let's say that it contains sensitive information that you don't want unauthorized user to see. At the very least you would:
Encrypt the worbook using native Excel functionality.
Password protect your VBA project using native functionality. This keeps savvier users from reading your code and making the xlSheetVeryHidden sheets Users and Plan1 visible to their prying eyes.
Now, you can't hide all sheets in a workbook at the same time, at least one needs to be visible at any given time ...
... so I've created a third sheet called SplashPage that doesn't contain any sensitive information. And that means I can hide all of the other worksheets until the user enters a valid UserID and password in frmLogin.
SplashPage can contain whatever you want. You can call it whatever you want. Typically, mine says something like:
Welcome to the Enemies List Application!
Only authorized users may access this workbook.
If you're seeing this page and no login form is visible
it means you've disabled the macros in this workbook.
Please make sure macro security is set to "Medium"
then close Excel entirely, reopen this file
and select "Enable Macros" when prompted.
If you attempt to view or modify this file without proper
authorization you will be added to the list herein.
-[Signed] Richard M. Nixon
A really really secure workbook would not contain the users and passwords in a hidden sheet. In fact, I never do this. Most of my apps are database driven, and I authenticate users against both the domain and a custom table in the application database. This effectively keeps anyone from using it unless they're onsite and connected to the network. I also usually flush all the data from the relevant worksheets when the user closes the workbook to a) keep the file size smaller and b) keep sensitive data from being stored in it and taken offsite. But that's beyond the original scope of your question.
'Why is [the following] necessary? What is being saved? Purpose?
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Save
A: There are two scenarios for closing the application: 1) a failed login attempt and 2) a successful login by a user who has finished making changes.
Take case (2) first. We want to hide all the sensitive information before closing so that the next person who opens the file only sees SplashPage and the login form. We know the user is closing the workbook because we have this code in the ThisWorkbook module BeforeClose event script:
'Module: ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
doWorkbookClose
End Sub
All it does is call this subroutine in Module1:
Sub doWorkbookClose()
On Error Resume Next
With Sheets("SplashPage")
.Visible = xlSheetVisible
.Activate
End With
Sheets("Plan1").Visible = xlSheetVeryHidden
Sheets("Users").Visible = xlSheetVeryHidden
ThisWorkbook.Save
End Sub
Since our close routine makes changes to the workbook to hide sensitive information, those changes need to be saved. If ThisWorkbook.Save wasn't there, Excel would prompt the user if they wanted to save "their" changes. Which is annoying at best, confusing at worst, because most users will have already pressed "Save" before closing. And if we give them the option here now to close without saving, then we run the risk of all those sensitive worksheets we've just made xlVeryHidden visible to the next user. And that next user could be a bad guy who knows how to disable macros (or anyuser who simply has macro security set above Medium) which means that the following code wouldn't run:
Private Sub Workbook_Open()
On Error Resume Next
Sheets("Users").Range("D1").Value = 3
With Sheets("SplashPage")
.Visible = xlSheetVisible
.Activate
End With
Sheets("Plan1").Visible = xlSheetVeryHidden
Sheets("Users").Visible = xlSheetVeryHidden
ThisWorkbook.Save
frmLogin.Show
End Sub
which is my semi-paranoid-self trying to make it as sure as possible that the next user opening this file doesn't see something I don't want them to.
Note that none of this secuity is bomb-proof. It will lock out most average Excel users that you don't want in it, but someone who knows more about VBA than I do could probably find a way in.
Yes, that was an invitation. :)