Password Protecting Individual Sheets

[bcfisher]

I would like to adjust the code found in the attached thread so that i can allow one person access to more than 1 sheet


http://www.mrexcel.com/forum/showthread.php?t=427756&page=2

any help would be much appreciated!

THANKS!

 

[Peter_SSs]

How can the code be adjusted so that the user would be able to see more than just one sheet? For example I have a speadsheet that will have two sheets that each user will need to see.

Welcome to the MrExcel bopard!

See if this more flexible approach is useful to you. For my test workbook I have ..

- A sheet called 'Public' that anybody can view. This sheet could be blank or have a message about not being able to view other sheets without providing appropriate login details etc.

- A 'LogIn' sheet somewhat similar to the previous example in this thread except that the sheets that a standard 'User' can view (apart from 'Public') are listed in column B separated by a "/". So you can see that BenSmith has access to only one other sheet, whereas BobB has access to 4 other sheets besides 'Public'.

- Three levels of access (though you don't need to use 'Manager' if you don't want).
A 'User' can only view quite restricted sheets as described above.
A 'Manager' can view all sheets except 'Login'.
An 'Admin' can view all sheets.

So here is my Login sheet from which you can deduce my worksheet names in addition to 'LogIn' and 'Public'.

Excel Workbook
	A	B	C	D
1	Username	Allowed Sheet Names	Status	Password
2	Admin		Admin	admin
3	JimJ		Manager	abc
4	JohnS		Manager	def
5	JenJ	Jen/Summary	User	jen
6	KenK	Ken/Profit & Loss	User	kkk
7	BobB	Bob/Ben/Jen/Summary	User	bob
8	BenSmith	Ben	User	ben
LogIn

And here are my 'ThisWorkbook' codes.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Dim ws As Worksheet
  
  Sheets("Public").Visible = True
  For Each ws In Worksheets
    If ws.Name <> "Public" Then ws.Visible = xlSheetVeryHidden
  Next ws
  ThisWorkbook.Save
End Sub

Private Sub Workbook_Open()
  Dim user As String, pwd As String, Correctpwd As String, Status As String
  Dim ct As Long, LR As Long, i As Long
  Dim C As Range
  Dim ws As Worksheet
  Dim AllowedSheets
  
  LR = Sheets("LogIn").Cells(Rows.Count, "A").End(xlUp).Row
  user = InputBox("Enter your UserName")
  Set C = Worksheets("LogIn").Range("$A1:$A" & LR).Find(What:=user, LookIn:=xlValues, MatchCase:=False, SearchFormat:=False)
  If Not C Is Nothing Then
    Status = C.Offset(, 2)
    Correctpwd = C.Offset(, 3)
    Do While ct < 3 And pwd <> Correctpwd
      pwd = InputBox("Enter Password: " & 3 - ct & " tries left")
      ct = ct + 1
    Loop
    If pwd = Correctpwd Then
      Application.ScreenUpdating = False
      If Status = "User" Then
        AllowedSheets = Split(C.Offset(, 1).Value, "/")
        For i = 0 To UBound(AllowedSheets)
          Sheets(AllowedSheets(i)).Visible = True
        Next i
      Else
        For Each ws In Worksheets
        ws.Visible = True
        Next ws
      End If
      If Status <> "Admin" Then
        Sheets("LogIn").Visible = xlVeryHidden
      End If
      Application.ScreenUpdating = True
    End If
  Else
    MsgBox "Not a valid user, access to other sheets denied"
  End If
End Sub

 

[Snakehips]

lynne1014,

Take a look at my recent response to a similar post and see if that helps any.

LOOK HERE

Tony

 

[mzahui]

I have tried your code and is not working even though I have set up my LogIn sheet exactly as you have suggested. I wanted the the user to have access to their individual sheet and the sample sheet, while the manager has access to all sheets and the Admin can modify (add or delete user to the LogIn sheet. My workbook name is Asset Register, and you can see the all the sheets in the workbook on the LogIn sheet except the Dropdown sheet that no one should have access but the Admin. Any help

Sample.xlsm
	A	B	C	D
1	Username	Sheet Name	Status	Password
2	Admin		admin	admin
3	ADFIN		Manager	ADFASST
4	BEN	CPC BENIN	User	benr01
5	SEN	CPC SENEGAL	User	senr01
6	MLI	CPC MALI	User	mlir01
7	BFA	CPC BURKINA FASO	User	bfar01
8	NER	CPC NIGER	User	nerr01
9	LBR	CPC LIBERIA	User	lbrr01
10	MRT	CPC MAURITANIA	User	mrtr01
11	RWA	CPC RWANDA	User	rwar01
12	NGA	CPC NIGERIA	User	ngar03
13	ZMB	CPC ZAMBIA	User	zmbr03
14	MWI	CPC MALAWI	User	mwir02
15	TZA	CPC TANZANIA	User	tzar02
16	UGA	CPC UGANDA	User	ugar02
17	ZWE	CPC ZIMBABWE	User	zwer02
18	KEN	CPC KENYA	User	kenr02
Login

 

[Peter_SSs]

I have tried your code ..

Not very precise. Is that my code from post #11, or my code from either of 2 earlier posts, or the code suggested by Snakehips?

Assuming you mean post #11 ..

1. What do you mean by the "Dropdown sheet"?

2. Can you confirm that the code was placed in the ThisWorkbook module and not a Standard Module or Worksheet Module?

3. Did you change the code in any way to suit your own circumstances? If so, can you post the code you have actually used? Also see my signature block for how to post code. Code tags are simplest.

4. When you open your Workbook, do you get a prompt asking for your UserName?

5. Do you have a worksheet called "Public" per my description?

 

[CLAIRE916]

I've tried to make this work . but I'm unable to can anyone help?