Password to enter the sheet

T

Tia

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
 
M

Mike H

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
 
T

Tia

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











- Show quoted text -
Click to expand...

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
 
M

Mike H

Tia,

I've no idea what you've done unless you post the code you have altered,
also you would have got an error message when the code stopped, what was it?
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
Click to expand...


If you want a different password for each sheet and don't want it written
down in each sheet then that means hard coding every password which is not
the way do do things because it would mean changing the code to add or remove
users.

Mike
 
T

Tia

Tia,

 I've no idea what you've done unless you post the code you have altered,
also you would have got an error message when the code stopped, what was it?


If you want a different password for each sheet and don't want it written
down in each sheet then that means hard coding every password which is not
the way do do things because it would mean changing the code to add or remove
users.

Mike








- Show quoted text -
Click to expand...

Ok its working whenever i click on the name a password is required but
if you simply right clicked and pressed unhide the sheet is
automaticly opened even thought there is a password in A1
Please advise what do i have to do in order to prevent the sheet from
being opened when an unhide option is being clicked


Tia
 
M

Mike H

use xlVeryHidden

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 = xlVeryHidden
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
Name"
End Sub

Mike
 
G

Gord Dibben

Where are you right-clicking and "Unhide"?

Maybe try setting Visible = False

to Visible = xlveryhidden

This should prevent any unhiding with a right-click.


Gord Dibben MS Excel MVP
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Protecting/Unprotecting all sheets with macro leads to "image" iss 3
Exclude worksheet from loop. 0
Trying to run excel vba code when cell value changes from empty to entered value. 1
Collapsing all groups 0
Excel Already selected values from DropDown list dynamically updating on multiple sheets 10
Find dupes, list in MsgBox with cell.address convert ws wide code toone sheet 6
Macro to unhide all except for. . . 5
How to hide password? 1

Top