Security levels

[ndello]

Is there a way to setup a worksheet with user privileges?
Lets say when John opens the workbook, he can put his id and password and he can only enter data into celss a1:a30.
Jane can access B1:b30
Mike can access all cells.
Can this be done?
thanks

 

[Von Pookie]

In Excel XP, there is an option to do just that.

Tools|Protection|Allow Users to edit ranges

Other than that, I can't really help

 

[JohnG]

you would need a form that opens when the workbook is opened and asks for user and password then checks a hidden sheet for a match. if match is found then looks up what privalige is to be used.

 

[JohnG]

Put this in the form(has 2 text boxes 3 buttons)


Dim PWDloop As Integer
Dim User As String
Dim UserRow As Integer
Dim UsrLevel As Integer
Dim Pwd As String
Dim TmpPwd As String
Dim PWDLastRow As Integer


Sub SearchUser()
User = "NULL"
PWDLastRow = Range(Worksheets("PWDDATA").UsedRange.Address).Rows.Count
For PWDloop = 1 To PWDLastRow
If UCase(UserForm1.TextBox1.Text) = Worksheets("PWDDATA").Range("A" & PWDloop).Value Then
User = UCase(UserForm1.TextBox1.Text)
UserRow = PWDloop
Exit For
End If
Next PWDloop
If User <> "NULL" Then
ReadPWD
Else
MsgBox "User Not Found.", vbCritical, ThisWorkbook.Name
End If
End Sub

Sub ReadPWD()
Pwd = Worksheets("PWDDATA").Range("B" & UserRow).Value
PWDDecipher
If UserForm1.TextBox2.Text = Pwd Then
UsrLevel = Worksheets("PWDDATA").Range("C" & UserRow).Value
MsgBox "Password accepted User Level is " & UsrLevel
Else
MsgBox "Password Incorrect"
End If
End Sub

Sub PWDDecipher()
TmpPwd = ""
For PWDloop = 1 To Len(Pwd)
TmpPwd = TmpPwd & Chr(Asc(Mid(Pwd, PWDloop, 1)) + (1 * PWDloop))
Next PWDloop
Pwd = TmpPwd
TmpPwd = ""
For PWDloop = Len(Pwd) To 1 Step -1
TmpPwd = TmpPwd & Mid(Pwd, PWDloop, 1)
Next PWDloop
Pwd = TmpPwd
End Sub

Sub PWDCipher()
TmpPwd = ""
For PWDloop = Len(Pwd) To 1 Step -1
TmpPwd = TmpPwd & Mid(Pwd, PWDloop, 1)
Next PWDloop
Pwd = TmpPwd
TmpPwd = ""
For PWDloop = 1 To Len(Pwd)
TmpPwd = TmpPwd & Chr(Asc(Mid(Pwd, PWDloop, 1)) - (1 * PWDloop))
Next PWDloop
Pwd = TmpPwd

End Sub

Private Sub CommandButton1_Click() 'OK
SearchUser
End Sub

Private Sub CommandButton2_Click() 'CHANGE
'change user data
End Sub

Private Sub CommandButton3_Click() 'EXIT
Unload UserForm1
End Sub

 

[ndello]

Thank you, I will give it a try