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