Solved: Code for Protecting a Specific Sheet in a Workbook with a Password on Exit

Hey,

I have a workbook which has a userform with a username and password scenerio. There are access levels to determine what the user can do on the sheet.
when a certain access user logs in it unprotects a sheet.
Does anyone know a code to protect the sheet on exit? Obviously if I dont have this code, user 1 with full access will come and unlock it and make changes then when he logs off user 2 can log on and access everything even though he supposed to have no access.

Thanks in Advance

Dave

There are many way to process it. to better figure out of your file, pls attach.
Rgs,
Lotuxel

The file is too big to attach.
To make it simple, what i am looking for is a piece of code so that when the user clicks on a button that says read only on it, it opens the file in a read only format.

Thanks

Dave

Try the following.
[VBA]Sub cmdBtn1_Click()
SetAttr "C:My DocumentsExpenses.xls", vbReadOnly
Workbooks.Open Filename:="C:My DocumentsExpenses.xls"
End Sub[/VBA]

Just change the file path name.

Thanks for the feeback. Tried the code but when i click the button nothing happens. My code is as below:

[VBA]Private Sub CboUSER_Change()
'// Login Page1
' Trap if user = blank
If Me.CboUSER.ListIndex = -1 Or Me.CboUSER = "" Then Exit Sub
Me.CboUSER.Text = Trim(Me.CboUSER.Text)
Me.Txtpassword.Enabled = True
Me.Txtpassword.SetFocus
End Sub
Private Sub cmdlogin_Click()
'// Login Page1
' If User passes test then get the access level for that user
Dim UserPass As String
Dim AccessLevel As Integer
Dim ws As Worksheet
Dim pass As String
Set ws = Worksheets("USERS")
pass = "treelinks"
With CboUSER
If .ListIndex = -1 Then 'prop Value set to comp/match excel will handle Invalid calls
UserPass = "Fooled1234" 'Set dummy pass if CboUser = ""
Else
UserPass = ws.Range("USERS").Cells(.ListIndex + 1, 2).Value
AccessLevel = ws.Range("USERS").Cells(.ListIndex + 1, 3).Value
End If
End With
If Me.Txtpassword.Text = UserPass Then
MsgBox "You Are Now Logged In As " & CboUSER 'change to suit
Select Case AccessLevel
Case 1
Worksheets("CURRENT").Visible = True
Worksheets("TEST").Visible = True
Case 2
Worksheets("CURRENT").Visible = True
Worksheets("USERS").Visible = True
Worksheets("TEST").Visible = True
Case 3
Worksheets("CURRENT").Visible = True
Worksheets("USERS").Visible = True
Worksheets("TEST").Visible = True
Set ws = Worksheets("HOME")
With ws
.Activate
End With
End Select
Unload Me
Else
MsgBox "Incorrect Password Try Again !"
Me.Txtpassword = ""
Me.Txtpassword.SetFocus
cmdlogin.Enabled = False
End If
End Sub
Private Sub CommandButton1_Click()
'// Login Page1 cancel button
'// Get out! dont save changes user has cancelled
ThisWorkbook.Saved = True 'save any changes
Worksheets("CURRENT").Protect Password = "treelinks"
Unload Me
ThisWorkbook.Close
Application.Quit
End Sub
Private Sub readyonlycmd_Click()
SetAttr "\\princes.co.uk\CoreData\Home\David.Thair\Desktop\Approved Supplier List..xlsm", vbReadOnly
Workbooks.Open Filename:="\\princes.co.uk\CoreData\Home\David.Thair\Desktop\Approved Supplier List..xlsm"
End Sub

Private Sub Txtpassword_AfterUpdate()
'// Page1 Login page password
cmdlogin.Enabled = True
End Sub
Private Sub UserForm_Initialize()
'// Load the combobox with defined name USERS
' Resize the list if any more users added
Dim ws As Worksheet
Set ws = Worksheets("USERS")
With ws
Me.CboUSER.List = ws.Range("USERS").Resize(, 2).Value
Me.Txtpassword.Enabled = False
End With
cmdlogin.Enabled = False
End Sub
' Stop the user closing the form disable the X close
Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Please use the Cancel or Exit Button !"
End If
End Sub[/VBA]

Thanks in advance!

Dave