password for each user to enter workbook

[tomtat]

i have some code for opening the workbook that only allows it to be opened if the correct name is entered.

would i then be able to have an individual password for each user after entering their name. if entry is wrong i would like the workbook to close.

the code i have is below


x = InputBox("Enter Your Name", "Authentication")If x = "False" Or x = "" Then MsgBox "Incorrect: you must enter a name" ActiveWorkbook.Close FalseEnd IfIf x <> "John" And x <> "Glen" Then MsgBox "Incorrect name" ActiveWorkbook.Close FalseEnd IfSheets("sheet1").Range("E3").Value = x</pre>

 

[royUK]

Have a look at this

PasswordForm

 

[tomtat]

this looks really good Roy but i don't have the skills to put this into my workbook

 

[dmt32]

Hi,
Add a worksheet to your workbook & Name it "User List" then enter Users name in Column A and their password in Column B. When done, you can hide it.

Use this updated version of your code & see if does what you want:

Sub Autorization()
    Dim ValidUser As Range
    Dim x(2) As Variant, sPrompt(2) As Variant
    
    i = 0
    Do
        sPrompt(i) = IIf(i = 0, "Enter Your Name", "Enter Your Password")
        x(i) = InputBox(sPrompt(i), "Authentication")
        'cancel pressed
        If StrPtr(x(i)) = 0 Then
            'cancel pressed
            ThisWorkbook.Close False
        ElseIf Len(x(i)) = 0 Then
            MsgBox "Incorrect: you must enter a name", 48, "Entry Required"
        Else
            Set ValidUser = Sheets("User List").Columns(i + 1).Find(x(i), LookIn:=xlValues, lookat:=xlWhole)
            If Not ValidUser Is Nothing Then
                If i = 1 Then
                    'user and password valid
                    Exit Do
                Else
                    i = i + 1
                End If
            Else
                msg = IIf(i = 0, x(0) & " does not have access to this file", "Invalid Password")
                MsgBox msg, 48, "Invalid Entry"
                ThisWorkbook.Close False
            End If
        End If
    Loop
End Sub

Dave.

 

[royUK]

Why not try and post back with specific questions.

If you open your workbook and the example by selecting the userform in the properties Window of the VB EDitor you can actually drag & drop it to your workbook.

 

[tomtat]

thanks for your response dave, this works how i want it to work. the only problem is i need it to put the name of the user in sheet1- cell E3. this is because i have a sheet that records who opens the workbook. from the name that is put in this cell i have some other code that puts it in a list on a table.

thanks
Tom

 

[dmt32]

thanks for your response dave, this works how i want it to work. the only problem is i need it to put the name of the user in sheet1- cell E3. this is because i have a sheet that records who opens the workbook. from the name that is put in this cell i have some other code that puts it in a list on a table.

thanks
Tom

Hi Tom,
just add a line of code to do that after the word Loop.

Sheets("Sheet1").Range("E3").Value = x(0)

Dave

 

[tomtat]

Thanks Dave, big help