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>
 
THe error only comes up when it is opened by more than one person..Is there a way to tell the other user(s) to close and come back later?
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Ok, maybe something like... UNTESTED
Rich (BB code):
Private Sub Workbook_Open()
Dim Password As String
    If ActiveWorkbook.ReadOnly = True Then
        MsgBox ("Sorry, This workbook is currently in use, please try again later !!")
        ActiveWorkbook.Close False
    End If
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 . It still gave the option to view the workbook as read only and the sheets that were unhidden for the first user. I need for it to not allow the second and subsequent user to open the workbook. Any ideas?

Thanks in advance and have a great weekend!
 
Upvote 0
I've added an exit sub to the If statement....but can't see why it would need it
Code:
Private Sub Workbook_Open()
Dim Password As String
    If ActiveWorkbook.ReadOnly = True Then
        MsgBox ("Sorry, This workbook is currently in use, please try again later !!")
        ActiveWorkbook.Close False
    Exit Sub
    End If
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

Forum statistics

Threads
1,223,714
Messages
6,174,052
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