Passwords VBA

[johnbird1988]

Hello
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
I have a sheet with 20 boxes scattered about and each 20 boxes represents an Employee. (For this example lets say al their name are “Employee 1 to 20”)
<o> </o>
Each of Employee boxes is a hyperlinked to their own individual sheet. Sheet names are also named from Employee 1 to 20. So I have 20 employee sheets and one sheet which is the home page that contains the hyperlink to each of the employees sheets.
<o> </o>
What I would like to do is instead of just a hyper link to some how when they click in their cell to ask for a password and depending on if the password is correct or no allow them access.
<o> </o>
I have a named range called “EPW” containing all the employee names and there passwords.
<o> </o>
Thanks for your help
<o> </o>
John

 

[lenze]

What sheet does EPW reside on??
Do you really need hyperlinks??
What kind of boxes? From the Drawing toolbar?
Why not just use cells and a DoubleClick
lenze

 

[johnbird1988]

EPW is the named range for the passwords to be able to do a look up for the correct password (this was my thought)

I don't need to use hyperlinks no but i did not want to use any boxes like from the drawing toolbar. What i ment by boxes is they are colour cells with in the Main sheet

What do you mean by cells and a double click.

Thank you

 

[lenze]

By DoubleClick, I mean the employee will actually doubleclick the cell with their name to activate the code and sheet. A couple of questions.
What cells are the employe's name in? Be specific!!!
What is the sheet name Range "EPW" is on?

lenze

 

[johnbird1988]

Ok the Employee Name Cells are:
D12, D15, D18, D21, D24, H12, H15, H18, H21, H24, L12, L15, L18, L21, L24, P12, P15, P18, P21, P25 on a sheet call Main.

The EPW is on a sheet called "Change Sheet" and range B5:C24. B = Employee Names and C is their Passwords.

Thank you

 

[lenze]

A little upfront work!!
Select ALL of the cells with employee names at once (Use the CTRL key). With them selected, name the range(myEmps). Now, place this code in the WorkSheet module. RightClick the sheet tab and choose "View Code"

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Intersect(Target, Range("myEmps")) Is Nothing Then Exit Sub
Dim C As Range
rspn = InputBox("Enter your password!")
With Sheets("Change Sheet").Range("EPW")
 Set C = .Find(Target, LookIn:=xlValues)
 If Not C Is Nothing Then
     If rspn <> C.Offset(0, 1) Then
       MsgBox "Wrong Password"
       Exit Sub
     Else: Sheets(Target.Text).Activate
     End If
 Else: MsgBox "Name not found"
 End If
 End With
End Sub

HTH
lenze

 

[lenze]

Thinking about this, you may wish to have the sheets hidden. You can do that with some extra code. In the ThisWorkBook module

Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Main" Then ws.Visible = xlSheetVeryHidden
Next ws
End Sub

Then in the previous code, Change

Else: Sheets(Target.Text).Activate

to

Else:
       Sheets(Target.Text).Visible = xlSheetVisible
       Sheets(Target.Text).Activate

lenze

 

[johnbird1988]

Thanks Lenze

I did maage to fix it in the end with the following code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If InputBox("Please enter in your password") <> Application.VLookup(ActiveCell.Value, Sheets("Change Sheet").Range("$B$5:$D$24"), 3, 0) Then
MsgBox ("Incorrect Password")
Range("A1").Select
Else

Sheets(Application.VLookup(ActiveCell.Value, Sheets("Change Sheet").Range("$B$5:$D$24"), 2, 0)).Visible = True

Sheets(Application.VLookup(ActiveCell.Value, Sheets("Change Sheet").Range("$B$5:$D$24"), 2, 0)).Select

End If

End Sub

Thank you for your help you given me the idea when you said double click

 

[lenze]

Try the code I wrote. It is much more efficient. Also, for better security, move the Open code to a BeforeSave code. Change

Private Sub Workbook_Open()

to

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

lenze