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>
 
WOW!! That's a list for sure. I think I'll start with Macros Made Easy for Microsoft Excel. Thanks again. Hopefully I can pass it forward someday.
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Hi Michael,

The code works great. Except when I input an incorrect password. The messagebox telling me the password is incorrect appears but it does not go back to the input password input box. I tried the GoTo command but I got errors.

Here is the code I used
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

Any suggestions?

Thanks in advance
 
Upvote 0
Try
Code:
Private Sub Workbook_Open()
Dim Password As String
ActiveWorkbook.Unprotect Password:="pwgsc"
Rtry:
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"
    GoTo Rtry
End Select
 ActiveWorkbook.Protect Password:="pwgsc"
 End Sub
 
Upvote 0
Hi Michael,

I tried the code; works great until I set it as a shared file on a shared drive. Got run-time error 1004: Method "unprotect" of object_workbook" failed. When I unshared the workbook it worked fine. Any suggestions?

Thanks in advance.
 
Upvote 0
Do you only get the error when it is open by more than one person ?
IF so, I don't believe there is a fix.....if it's shared, first in has control....there may be other posters than can give further guidance, if I'm wrong !
 
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.

hello all. Could I have a question please?

what are opening macro and closing macro?

Thanks
 
Upvote 0
Vanda
You realise it's against forum policy to jump into other posters threads !!

A workbook_Open macro activates as soon as the user opens the workbook and runs automatically
A workbook_before macro runs as the last activity before the workbook closes and runs automatically
 
Upvote 0
Vanda
You realise it's against forum policy to jump into other posters threads !!

A workbook_Open macro activates as soon as the user opens the workbook and runs automatically
A workbook_before macro runs as the last activity before the workbook closes and runs automatically

I will remember. sorry. For others' questions, I can only read or help them solve the problem?
 
Upvote 0
I will remember. sorry. For others' questions, I can only read or help them solve the problem?
You were asking about the code posted in the thread, so you really didn't do anything wrong here. :)
 
Upvote 0

Forum statistics

Threads
1,216,006
Messages
6,128,236
Members
449,435
Latest member
Jahmia0616

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