On Oct 13, 1:10*pm, Mike H wrote:
Hi,

Try this,

This goes in sheet 'Menu'
The password for each sheet is in A1 of each user sheet which the User can
change by simply altering the text in that cell. You can put the password
anywhere in the users sheet but you need to alter this line

If response = Sheets(Target.Value).Cells(1, 1).Value Then

to tell the code where it is. A word of caution, this IS NOT secure, anyone
with a rudimentary understanding of VB would defeat this in moments.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim SheetExists As Boolean
Dim ws As Worksheet
SheetExists = False
Dim RngOfNames As Range
If Target.Count 1 Then Exit Sub
* * If Range("D1").Value = "Tia" Then Exit Sub
* * * * Set RngOfNames = Union(Range("B8:B25"), Range("E8:E25"),
Range("F8:F25"))
* * * * Application.ScreenUpdating = False
* * * If Not Intersect(Target, RngOfNames) Is Nothing Then
* * * * * * For Each ws In ThisWorkbook.Worksheets
* * * * * * * * * If ws.Name < "Main" Then ws.Visible = False
* * * * * * Next ws
* * * * * * On Error GoTo NoSht
For x = 1 To Worksheets.Count
* * If Sheets(x).Name = Target.Value Then
* * * * SheetExists = True
* * * * Exit For
* * End If
Next
If SheetExists = False Then GoTo NoSht
response = InputBox("Enter your password", vbOKOnly)
* * * * * * If response = Sheets(Target.Value).Cells(1, 1).Value Then
* * * * * * * * Sheets(Target.Value).Visible = True
* * * * * * * * Sheets(Target.Value).Select
* * * * * * Else
* * * * * * * * MsgBox "Incorrect Password"
* * * * * * * * Application.ScreenUpdating = True
* * * * * * * * Exit Sub
* * * * * * End If
* * * * * * End If
* * * Application.ScreenUpdating = True
* * * Exit Sub
NoSht:
* * * On Error GoTo 0
* * * MsgBox "There is no sheet named " & Target.Value & ".", 16, "Invalid
Sheet Name"
End Sub

Mike



"Tia" wrote:
Please advise regarding the VBA code that allows me to have a password
for each sheet

I have used a code that allows me to always have the main sheet and
thrue it i can access the other sheet what i need is that whenever an
employee press on his name a password is required . what is the code
that i should use
and put in each sheet so the password appears to be filled ?
*I am using the following code :
In the main sheet
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
* * * Dim ws As Worksheet
* * * Dim RngOfNames As Range
* * * If Target.Count 1 Then Exit Sub
* * * *If Range("D1").Value = "Tia" Then Exit Sub
* * * Set RngOfNames = Union(Range("B8:B25"), Range("E8:E25"),
Range("F8:F25"))
* * * Application.ScreenUpdating = False
* * * If Not Intersect(Target, RngOfNames) Is Nothing Then
* * * * * * For Each ws In ThisWorkbook.Worksheets
* * * * * * * * * If ws.Name < "Main" Then ws.Visible = False
* * * * * * Next ws
* * * * * * On Error GoTo NoSht
* * * * * * Sheets(CStr(Target.Value)).Visible = True
* * * * * * Sheets(CStr(Target.Value)).Select
* * * End If
* * * Application.ScreenUpdating = True
* * * Exit Sub
NoSht:
* * * On Error GoTo 0
* * * MsgBox "There is no sheet named " & Target.Value & ".", 16,
"Invalid Sheet Name"
End Sub

In this Workbook
Option Explicit

Private Sub Workbook_Open()
* * * Dim ws As Worksheet
* * * Sheets("Main").Select
* * * If Range("D1").Value = "Tia" Then
* * * * * * For Each ws In ThisWorkbook.Worksheets
* * * * * * * * * ws.Visible = True
* * * * * * Next ws
* * * End If
End Sub

Please advise

Thank you i advance- Hide quoted text -

- Show quoted text -

I have tried the following code and i have copy and paste it in the
"Main Sheet" all i have done is to change the password to "Tali"
when i save and try to reopen i am having a yellow line on the
following sentence :Private Sub Worksheet_SelectionChange(ByVal Target
As Range)
I dont have to put anything in each sheet ? since i want a different
password for each sheet and since i have 10 sheets besides the Main
sheet


Please advise
Thank you in advance

Tia