Security levels

ndello

Active Member
Joined
Oct 16, 2002
Messages
382
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
 

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Von Pookie

MrExcel MVP
Joined
Feb 17, 2002
Messages
13,686
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

Board Regular
Joined
Feb 18, 2002
Messages
165
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

Board Regular
Joined
Feb 18, 2002
Messages
165
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,469
Messages
5,596,314
Members
414,053
Latest member
Dual Showman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top