Help! Code to password protect sheets

[KSgirl]

I'm really hoping someone can help me with this code! I've searched this forum and found some older posts about it but I still I can't get my coding to work!! There will be seven people using this workbook and they're each assigned their own tab to work with. I've got cells locked and each sheet is protected so they can't delete formulas or anything. I don't want them to be able to see any other tabs or input data into any tab but their own and I want them to have to enter a password in order to view their tab! Here's the coding that I am using but it's not working for me!!

I'd be happy to email my spreadsheet to someone if they'd like to help me with this code!!

Sub autho()
Dim i_pwd As String

i_pwd = InputBox("Please Enter your Password")
If i_pwd = "" Then
Exit Sub
End If

Select Case LCase(i_pwd)

Case Is = "juice"


Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

ws.Visible = xlSheetVisible



Next ws
MsgBox "As an Administrator all sheets are now visible to you.", vbInformation, ""

Case Is = "apple"
Worksheets("Sheet1").Visible = True
Sheets("Sheet1").Activate


Case Is = "secret"
Worksheets("Sheet2").Visible = True
Sheets("Sheet2").Activate


Case Is = "airplane"
Worksheets("Sheet3").Visible = True
Sheets("Sheet3").Activate


Case Is = "toast"
Worksheets("Sheet4").Visible = True
Sheets("Sheet4").Activate


Case Is = "plant"
Worksheets("Sheet5").Visible = True
Sheets("Sheet5").Activate


Case Is = "water"
Worksheets("Sheet6").Visible = True
Sheets("Sheet6").Activate

Case Is = "pilot"
Worksheets("Sheet7").Visible = True
Sheets("Sheet7").Activate

Case Else
MsgBox "Incorrect password; no action taken.", vbInformation, ""
End Select
End Sub

 

[Dosnox]

Hi KsGirl

You just need to add code to hide the other worksheets when you only want one visible.
To make it easier I have created an extra procedure that will hide all other worksheets other than the one which was input:

Sub Hidwrk(Wrksht As String)
Dim ws1 As Worksheet
For Each ws1 In ThisWorkbook.Worksheets
If ws1.Name <> Wrksht Then
ws1.Visible = xlSheetHidden
End If
Next ws1
End Sub

I have edited your code to include this and should now be working.

Sub autho()
Dim i_pwd As String

i_pwd = InputBox("Please Enter your Password")
If i_pwd = "" Then
Exit Sub
End If

Select Case LCase(i_pwd)

Case Is = "juice"


Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

ws.Visible = xlSheetVisible



Next ws
MsgBox "As an Administrator all sheets are now visible to you.", vbInformation, ""

Case Is = "apple"
Worksheets("Sheet1").Visible = True
Call Hidwrk("Sheet1")
Sheets("Sheet1").Activate


Case Is = "secret"
Worksheets("Sheet2").Visible = True
Call Hidwrk("Sheet2")
Sheets("Sheet2").Activate


Case Is = "airplane"
Worksheets("Sheet3").Visible = True
Call Hidwrk("Sheet3")
Sheets("Sheet3").Activate


Case Is = "toast"
Worksheets("Sheet4").Visible = True
Call Hidwrk("Sheet4")
Sheets("Sheet4").Activate


Case Is = "plant"
Worksheets("Sheet5").Visible = True
Call Hidwrk("Sheet5")
Sheets("Sheet5").Activate


Case Is = "water"
Worksheets("Sheet6").Visible = True
Call Hidwrk("Sheet6")
Sheets("Sheet6").Activate

Case Is = "pilot"
Worksheets("Sheet7").Visible = True
Call Hidwrk("Sheet7")
Sheets("Sheet7").Activate

Case Else
MsgBox "Incorrect password; no action taken.", vbInformation, ""
End Select
End Sub

Hope it helps