restrict which sheets a user can view

yangsan01

New Member
Joined
Feb 18, 2013
Messages
27
I am trying to find a way to restrict which sheets a user can view by using a username and password. I am testing it first on a simple workbook called TEST with only 3 sheets and 2 users but eventually it will be used on a workbook with approx. 20 sheets and about 8 users and an administrator.

I am a beginner beginner at VBA.

Here is the code I have so far:


Dim bOK2Use As BooleanPrivate Sub btnOK_Click() Dim bError As Boolean Dim sSName As String Dim p As DocumentProperty Dim bSetIt As Boolean bOK2Use = False bError = True If Len(txtUser.Text) > 0 And Len(txtPass.Text) > 0 Then bError = False Select Case txtUser.Text Case "user1" sSName = "u1sheet" If txtPass.Text <> "u1pass" Then bError = True Case "user2" sSName = "u2sheet" If txtPass.Text <> "u2pass" Then bError = True Case Else bError = True End Select End If If bError Then MsgBox "Invalid User Name or Password" Else 'Set document property bSetIt = False For Each p In ActiveWorkbook.CustomDocumentProperties If p.Name = "auth" Then p.Value = sSName bSetIt = True Exit For End If Next p If Not bSetIt Then ActiveWorkbook.CustomDocumentProperties.Add _ Name:="auth", LinkToContent:=False, _ Type:=msoPropertyTypeString, Value:=sSName End If Sheets(sSName).Visible = True Sheets(sSName).Unprotect (txtPass.Text) Sheets(sSName).Activate bOK2Use = True Unload UserForm1 End IfEnd SubPrivate Sub UserForm_Terminate() If Not bOK2Use Then ActiveWorkbook.Close (False) End IfEnd SubThe code won't run and asks me to debug. In VBA the yellow arrow points to the following line:
If Len(txtUser.Text) > 0 And Len(txtPass.Text) > 0 ThenAny help would be greatly appreciated.Thanks in advance!
</pre></pre>
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Have a look at my sig block and use the code tags to display your code.
That will assist others to be better able to read it.
 
Upvote 0
Thanks Michael. Still very new at this. Please accept my apologies.

Here is the code:

Code:
[COLOR=#000000]Dim bOK2Use As Boolean[/COLOR]
Private Sub btnOK_Click()    
Dim bError As Boolean    
Dim sSName As String    
Dim p As DocumentProperty    
Dim bSetIt As Boolean    
bOK2Use = False    
bError = True    
If Len(txtUser.Text) > 0 And Len(txtPass.Text) > 0 Then        
bError = False        
Select Case txtUser.Text            

Case "user1"                
sSName = "u1sheet"                
If txtPass.Text <> "u1pass" Then bError = True            

Case "user2"                
sSName = "u2sheet"                
If txtPass.Text <> "u2pass" Then bError = True            

Case Else                
bError = True        
End Select    End If    
If bError Then        
MsgBox "Invalid User Name or Password"    
Else        
'Set document property       
bSetIt = False        
For Each p In ActiveWorkbook.CustomDocumentProperties            
If p.Name = "auth" Then                
p.Value = sSName                
bSetIt = True                
Exit For            
End If        
Next p        
If Not bSetIt Then            
ActiveWorkbook.CustomDocumentProperties.Add _              
Name:="auth", LinkToContent:=False, _              
Type:=msoPropertyTypeString, Value:=sSName        
End If        
Sheets(sSName).Visible = True        
Sheets(sSName).Unprotect (txtPass.Text)        
Sheets(sSName).Activate        
bOK2Use = True        
Unload UserForm1    
End IfEnd SubPrivate Sub UserForm_Terminate()    
If Not bOK2Use Then        
ActiveWorkbook.Close (False)    
End If
End Sub
 
Upvote 0
Maybe consider something like.....
Code:
Sub HideSheets()
Dim Password As String
Password = InputBox("Enter Password")
If Password = "" Then Exit Sub
Select Case Password
Case Is = "Bob"
     Worksheets("Sheet1").Visible = True
     Worksheets("Sheet3").Visible = True
Case Is = "Fred"
     Worksheets("Sheet2").Visible = True
     Worksheets("Sheet4").Visible = True
Case Is = "John"
     Worksheets("Sheet5").Visible = True
     Worksheets("Sheet6").Visible = True
Case Is = "Judy"
     Worksheets("Sheet7").Visible = True
     Worksheets("Sheet8").Visible = True
End Select
End Sub
Private Sub auto_Close() 'At least one sheet must be visible
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Master" Then ws.Visible = xlSheetHidden ' Change to suit
Next ws
End Sub
 
Upvote 0
Hi Michael. I tried the code you suggested. Here is how I modified it:
Rich (BB code):
Sub HideSheets()Dim Password As String
Password = InputBox("Enter Password")
If Password = "" Then Exit Sub
Select Case Password
Case Is = "Bob"
     Worksheets("DND").Visible = True
     Worksheets("NHW").Visible = True
Case Is = "Walter"
     Worksheets("CSD").Visible = True
     Worksheets("IMC").Visible = True
     Worksheets("IRB").Visible = True
Case Is = "Sharon"
     Worksheets("GSS").Visible = True
     Worksheets("PEN").Visible = True
     Worksheets("PPD").Visible = True
     Worksheets("IAN").Visible = True
Case Is = "Michelle"
     Worksheets("NAR").Visible = True
     Worksheets("JUS").Visible = True
 Case Is = "Alvan"
     Worksheets("DOE").Visible = True
     Worksheets("DVA").Visible = True
     Worksheets("AGR").Visible = True
     Worksheets("DUS").Visible = True
Case Is = "Alex"
     Worksheets("SVC").Visible = True
     Worksheets("RSN").Visible = True
     Worksheets("RAP").Visible = True
     Worksheets("RCM").Visible = True
Case Is = "Aaron"
     Worksheets("DFO").Visible = True
     Worksheets("BSF").Visible = True
  Case Is = "Chief"
    Worksheets("GSS").Visible = True
     Worksheets("PEN").Visible = True
     Worksheets("PPD").Visible = True
     Worksheets("IAN").Visible = True
     Worksheets("CSD").Visible = True
     Worksheets("IMC").Visible = True
     Worksheets("IRB").Visible = True
     Worksheets("NAR").Visible = True
     Worksheets("JUS").Visible = True
     Worksheets("DND").Visible = True
     Worksheets("NHW").Visible = True
     Worksheets("DOE").Visible = True
     Worksheets("DVA").Visible = True
     Worksheets("AGR").Visible = True
     Worksheets("DUS").Visible = True
     Worksheets("SVC").Visible = True
     Worksheets("RSN").Visible = True
     Worksheets("RCM").Visible = True
     Worksheets("RAP").Visible = True
     Worksheets("DFO").Visible = True
     Worksheets("BSF").Visible = True
     Worksheets("WIP Report").Visible = True
     Worksheets("ROLL UP PO 66").Visible = True

End Select
End Sub
Private Sub auto_Close() 'At least one sheet must be visible
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Chief" Then ws.Visible = xlSheetHidden ' Change to suit
End Sub


This gave me a debug message regarding "if ws.name <>" line

When I removed this line it worked when I used F5 but did not show message box at start of Excel and the sheets that were made visible with the previous password were visible with WB was re-opened.

This WB is running on Excel 2007 and the sheets are protected and so is the WB.

I am very new at this and am not sure how to debug. I also added a new sheet with nothing in it which will not be hidden or protected.

Any assistance would be greatly appreciated.

 
Last edited:
Upvote 0
Ok, check the spelling of "Chief", make sure the syntax is correct, the case is correct
AND
there are no hidden, trailling, leading or extra spaces in the name

Your font was really hard to read but it appears there is an error in the Auto close code

Try
Code:
Private Sub auto_Close() 'At least one sheet must be visible
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Chief" Then ws.Visible = xlSheetHidden ' Change to suit
next ws
End Sub
 
Upvote 0
Hi Michael. Here's what I have so far.

The open workbook macro:

Code:
Private Sub Workbook_Open()
Dim Password As String
ActiveWorkbook.Unprotect Password:="pwgsc"
'Error handling
On Error GoTo BadEntry
Password = InputBox("Enter Password")
If Password = "" Then Exit Sub
Select Case Password
Case Is = "Bob"
     Worksheets("DND").Visible = True
     Worksheets("NHW").Visible = True
Case Is = "Walter"
     Worksheets("CSD").Visible = True
     Worksheets("IMC").Visible = True
     Worksheets("IRB").Visible = True
Case Is = "Sharon"
     Worksheets("GSS").Visible = True
     Worksheets("PEN").Visible = True
     Worksheets("PPD").Visible = True
     Worksheets("IAN").Visible = True
Case Is = "Michelle"
     Worksheets("NAR").Visible = True
     Worksheets("JUS").Visible = True
 Case Is = "Alvan"
     Worksheets("DOE").Visible = True
     Worksheets("DVA").Visible = True
     Worksheets("AGR").Visible = True
     Worksheets("DUS").Visible = True
Case Is = "Alex"
     Worksheets("SVC").Visible = True
     Worksheets("RSN").Visible = True
     Worksheets("RAP").Visible = True
     Worksheets("RCM").Visible = True
Case Is = "Aaron"
     Worksheets("DFO").Visible = True
     Worksheets("BSF").Visible = True
  Case Is = "Chief"
     Worksheets("GSS").Visible = True
     Worksheets("PEN").Visible = True
     Worksheets("PPD").Visible = True
     Worksheets("IAN").Visible = True
     Worksheets("CSD").Visible = True
     Worksheets("IMC").Visible = True
     Worksheets("IRB").Visible = True
     Worksheets("NAR").Visible = True
     Worksheets("JUS").Visible = True
     Worksheets("DND").Visible = True
     Worksheets("NHW").Visible = True
     Worksheets("DOE").Visible = True
     Worksheets("DVA").Visible = True
     Worksheets("AGR").Visible = True
     Worksheets("DUS").Visible = True
     Worksheets("SVC").Visible = True
     Worksheets("RSN").Visible = True
     Worksheets("RCM").Visible = True
     Worksheets("RAP").Visible = True
     Worksheets("DFO").Visible = True
     Worksheets("BSF").Visible = True
     Worksheets("WIP Report").Visible = True
     Worksheets("ROLL UP PO 66").Visible = True


BadEntry:
    Msg = "Invalid Password" & vbNewLine & vbNewLine
    Msg = Msg & "Please enter a valid Password"
    
 ActiveWorkbook.Protect Password:="pwgsc"
    


End Select
End Sub

And here is the closing macro:
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
ActiveWorkbook.Unprotect Password:="pwgsc"
    Worksheets("GSS").Visible = False
     Worksheets("PEN").Visible = False
     Worksheets("PPD").Visible = False
     Worksheets("IAN").Visible = False
     Worksheets("CSD").Visible = False
     Worksheets("IMC").Visible = False
     Worksheets("IRB").Visible = False
     Worksheets("NAR").Visible = False
     Worksheets("JUS").Visible = False
     Worksheets("DND").Visible = False
     Worksheets("NHW").Visible = False
     Worksheets("DOE").Visible = False
     Worksheets("DVA").Visible = False
     Worksheets("AGR").Visible = False
     Worksheets("DUS").Visible = False
     Worksheets("SVC").Visible = False
     Worksheets("RSN").Visible = False
     Worksheets("RCM").Visible = False
     Worksheets("RAP").Visible = False
     Worksheets("DFO").Visible = False
     Worksheets("BSF").Visible = False
     Worksheets("WIP Report").Visible = True
     Worksheets("ROLL UP PO 66").Visible = False
ActiveWorkbook.Protect Password:="pwgsc"


End Sub


I still have the following problems:

When an incorrect username is input the GoTo BadEntry doe not work. It just opens the workbook with the WIP Report sheet showing.

and



It does not password protect the workbook when closing nor when a correct password has been entered.

I really appreciate all your help. I am very new at this (2 weeks). I have been reading VBA for Dummies; could you suggest other reading material? I am also thinking about doing a class; would that be worth the time and money or should I just play it by ear?

Thanks for all your time, knowledge and effort.
 
Upvote 0
I don't have access to Excel at the moment, but try these.
With regard to your other question regarding learning....here is a list of training, sites, books, etc..kindly compiled by Hiker95, that you could consider to improve your skills.
Classes suit some people, and not others. Personally I wouldn't waste the money, keep hanging around forums like these and look at the questions AND how they are answered, copy and paste the data into workbooks, and then either deconstruct the code or make changes and see what happens.

Code first
Code:
Private Sub Workbook_Open()
Dim Password As String
ActiveWorkbook.Unprotect Password:="pwgsc"
Password = InputBox("Enter Password")
If Password = "" Then Exit Sub
Select Case Password
Case Is = "Bob"
     Worksheets("DND").Visible = True
     Worksheets("NHW").Visible = True
Case Is = "Walter"
     Worksheets("CSD").Visible = True
     Worksheets("IMC").Visible = True
     Worksheets("IRB").Visible = True
Case Is = "Sharon"
     Worksheets("GSS").Visible = True
     Worksheets("PEN").Visible = True
     Worksheets("PPD").Visible = True
     Worksheets("IAN").Visible = True
Case Is = "Michelle"
     Worksheets("NAR").Visible = True
     Worksheets("JUS").Visible = True
 Case Is = "Alvan"
     Worksheets("DOE").Visible = True
     Worksheets("DVA").Visible = True
     Worksheets("AGR").Visible = True
     Worksheets("DUS").Visible = True
Case Is = "Alex"
     Worksheets("SVC").Visible = True
     Worksheets("RSN").Visible = True
     Worksheets("RAP").Visible = True
     Worksheets("RCM").Visible = True
Case Is = "Aaron"
     Worksheets("DFO").Visible = True
     Worksheets("BSF").Visible = True
Case Is = "Chief"
     Worksheets("GSS").Visible = True
     Worksheets("PEN").Visible = True
     Worksheets("PPD").Visible = True
     Worksheets("IAN").Visible = True
     Worksheets("CSD").Visible = True
     Worksheets("IMC").Visible = True
     Worksheets("IRB").Visible = True
     Worksheets("NAR").Visible = True
     Worksheets("JUS").Visible = True
     Worksheets("DND").Visible = True
     Worksheets("NHW").Visible = True
     Worksheets("DOE").Visible = True
     Worksheets("DVA").Visible = True
     Worksheets("AGR").Visible = True
     Worksheets("DUS").Visible = True
     Worksheets("SVC").Visible = True
     Worksheets("RSN").Visible = True
     Worksheets("RCM").Visible = True
     Worksheets("RAP").Visible = True
     Worksheets("DFO").Visible = True
     Worksheets("BSF").Visible = True
     
     Worksheets("ROLL UP PO 66").Visible = True
Case Else
    MsgBox "Invalid Password" & vbNewLine & vbNewLine _
    & "Please enter a valid Password"
End Select
 ActiveWorkbook.Protect Password:="pwgsc"
 End Sub



Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
ActiveWorkbook.Unprotect Password:="pwgsc"
Worksheets("WIP Report").Visible = True
For Each ws In Worksheets
    If ws.Name <> "WIP Report" Then
    ws.Visible = False
    End If
 Next ws
ActiveWorkbook.Protect Password:="pwgsc"
End Sub

Here's the list

Training / Books / Sites as of 05/21/2012

MrExcel's Products: Books, CDs, Podcasts Discuss topics related to Holy Macro! Products: Learn Excel from MrExcel, VBA and Macros for Microsoft Excel,Holy Macro! It's 2500 VBA Examples CD, Guerilla Data Analysis Using Microsoft Excel and Excel Knowledge Base CD and the MrExcel Podcasts.
MrExcel's Products: Books, CDs, Podcasts

There are over 1800 Excel videos/tutorials here:
excelisfun -- Excel How To Videos - YouTube

Getting Started with VBA.
DataPig Technologies

If you are serious about learning VBA try
Macros Made Easy for Microsoft Excel

Excel Tutorials and Tips - VBA - macros - training
Excel Tutorial | Excel Tips | Excel Articles

Here's a good primer on the scope of variables.
Scope Of Variables And Procedures

See David McRitchie's site if you just started with VBA
Getting Started with Macros and User Defined Functions

What is a Visual Basic Module?
http://www.emagenit.com/VBA Folder...vba_module.htm

Ron de Bruin's intro to macros:
Where do I paste the code that I want to use in my workbook

Creating An XLA Add-In For Excel, Writing User Defined Functions In VBA
Creating An XLA Add In

How do I create a PERSONAL.XLS(B) or Add-in
How do I create a PERSONAL.XLS(B) or Add-in

Creating custom functions
http://office.microsoft.com/en-us/ex...117011033.aspx

Writing Your First VBA Function in Excel
Writing Your First VBA Function in Excel

VBA for Excel (Macros)
Excel Macros (VBA) Tutorial

VBA Lesson 11: VBA Code General Tips and General Vocabulary
VBA for Excel macros language

Excel VBA -- Adding Code to a Workbook
Excel VBA -- Adding Code to Excel Workbook

Learn to debug:
Debugging VBA

How To: Assign a Macro to a Button or Shape
http://peltiertech.com/WordPress/how...tton-or-shape/

User Form Creation
Create an Excel UserForm

When To Use a UserForm & What to Use a UserForm For
http://www.ozgrid.com/Excel/free-tra...ba2lesson2.htm

Excel Tutorials / Video Tutorials - Functions
Excel VLookup Function Examples

INDEX MATCH - Excel Index Function and Excel Match Function
Excel Index Function and Match Function

Excel Data Validation
Excel Data Validation Tips and Quirks
http://www.contextures.com/excel-dat...ation-add.html

Your Quick Reference to Microsoft Excel Solutions
XL-CENTRAL.COM : For your Microsoft Excel Solutions

New! Excel Recorded Webinars
DataPig Technologies

Programming The VBA Editor - Created by Chip Pearson at Pearson Software Consulting LLC
This page describes how to write code that modifies or reads other VBA code.
Programming In The VBA Editor

VBA and Macros for Microsoft Excel, by Bill Jelen "Mr.Excel" and Tracy Syrstad

Excel Hacks 100 Industrial-Strength Tips & Tools, by David & Traina Hawley

VBA and Macros for Microsoft Excel 2007, by Bill Jelen "Mr.Excel" and Tracy Syrstad

Excel 2007 Book: you can try this...there is a try before you buy ebook available at this link…

by Stephen/ Bovey, Rob/ Green, John Bullen (Paperback - Feb 11, 2005)
Professional Excel Development

by Rob Bovey, Stephen Bullen, John Green, and Robert Rosenberg (Paperback - Sep 26, 2001)
Excel 2002 VBA: Programmers Reference

DonkeyOte: My Recommended Reading, Volatility
Volatile Excel Functions -Decision Models

Sumproduct
http://www.xldynamic.com/source/xld.SUMPRODUCT.html

Arrays
Excel: Introduction to Array Formulas - Xtreme Visual Basic Talk
Array in Excel VBA

Pivot Intro
Using Pivot Tables and Pivot Charts in Microsoft Excel

Email from XL - VBA
Example Code for sending mail from Excel

Outlook VBA
Writing VBA code for Microsoft Outlook

Function Dictionary
http://www.xlfdic.com/

Function Translations
Excel 2007 function name translations - Dictionary Chart Front Page

Dynamic Named Ranges
Excel Names -- Excel Named Ranges

How to create Excel Dashboards
http://www.mrexcel.com/Excel-dashboards-Xcelsius.html
Excel Dashboard Templates
Excel Dashboards - Templates, Tutorials, Downloads and Examples | Chandoo.org - Learn Microsoft Excel Online
Excel Dashboards - Templates, Tutorials, Downloads and Examples | Chandoo.org - Learn Microsoft Excel Online
Free Microsoft Excel Dashboard Widgets to Download
AJP Excel Information - Gauge

Excel Dashboard / Scorecard Ebook
Excel Dashboards and Scorecards Ebook | How to Create Dashboards in Excel

Mike Alexander from Data Pig Technologies
Excel 2007 Dashboards & Reports For Dummies

Templates
CPearson.com Topic Index
http://www.contextures.com/excel-tem...lf-scores.html

Date & Time stamping:
McGimpsey & Associates : Excel : Time and date stamps

Get Formula / Formats thru custom functions:
Show FORMULA or FORMAT of another cell

A nice informative MS article "Improving Performance in Excel 2007"
Improving Performance in Excel 2007

Progress Meters
AJP Excel Information - Progress meters
Website Disabled

And, as your skills increase, try answering posts on sites like:
MrExcel.com | Excel Resources | Excel Seminars | Excel Products
Excel Help Forum
Excel Templates | Excel Add-ins and Excel Help with formulas and VBA Macros
VBA Express Portal
Excel, Access, PowerPoint and Word VBA Macro Automation Help
__________________
Have a great day,
hiker95
 
Upvote 0

Forum statistics

Threads
1,223,713
Messages
6,174,043
Members
452,542
Latest member
Bricklin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top