Userform Login

**clint182** · 06-27-2011, 07:14 PM

Hi All,

I have a document with 10 different tabs all containing Important data and therefore needs protecting.
I want to have 3 seperate log-in's with each login having diffferent access....

User 1: Access and Edit entire document
User 2: Access to edit tab 1 and read only all other tabs
User 3: Read only entire document.

I have created the user form with 3 checkboxes plus space for entering a username and password.

I have worked out the code for 1 username and password but am struggling with the rest.

Help is appreciated.

**Leith Ross** · 06-27-2011, 07:18 PM

Hello clint182,

It would help to see what code you already have. If you can post the workbook, that would be best. If not then post the code.

**clint182** · 06-27-2011, 07:32 PM

Hi,
I have attached the document with the code i have doen so far....
(For obvious reasons the sheets are blank, but the tabs have their correct names)

Username: user
Password: password

Thanks

**Leith Ross** · 06-27-2011, 07:42 PM

Hello clint182,

Thanks for posting the workbook. What user names should I add to the UserForm?

**clint182** · 06-27-2011, 08:03 PM

Hi,
Was thinking
User 1: Admin
User 2: Data Input
User 3: Reporting
Thanks

**Leith Ross** · 06-27-2011, 08:13 PM

Hello clint182,

I used a Select Case statement to validate the user name and password. I also added a module that remove the close "X" from the UserForm. I really get annoyed by clicking the close "X" and being told it doesn't work or to use another button. here is the UserForm code. Change the passwords to what you want. To help keep the worksheet passwords safer, you should lock the VBA project from viewing .

Sub ProtectAllSheets()

  Dim Wks As Worksheet
  
    For Each Wks In Worksheets
      Wks.Protect "password"
    Next Wks
    
End Sub

Private Sub CommandButton1_Click()

Dim username, password As String
Dim Wks As Worksheet

  username = TextBox1.Text
  password = TextBox2.Text

  Select Case TextBox1.Text
    Case Is = "Adimn"
      If TextBox2.Text = "FullAccess" Then
        'Unprotect all sheets
         For Each Wks In Worksheets
           Wks.Unprotect "password"
         Next Wks
      End If
      
    Case Is = "Data Input"
      If TextBox2.Text = "Restricted" Then
        'Protect all sheets
         ProtectAllSheets
        'Unprotect Sheet1 (Master)
         Sheet1.Unprotect "password"
      End If
         
    Case Is = "Reporting"
      If TextBox2.Text = "ReadOnly" Then
        'Protect all sheets
         ProtectAllSheets
      End If
      
    Case Else
      MsgBox "You entered the WRONG info. Please try agian", vbCritical
  End Select
  
  Unload Me
  
End Sub

Private Sub UserForm_Activate()
  NoCloseX
End Sub

**clint182** · 06-27-2011, 09:27 PM

Thanks for your assistamce in solving my problem.

**clint182** · 06-27-2011, 11:36 PM

Hi Again,

Just one last thing, i have been trying to research the code but had no luck.

With the current code if the password is incorrect it still allows acess to the document...
Is there a way to make it that is the username/password is incorrect then it doesnt open the document?

I am currently using the above formaule.

Thanks

**Leith Ross** · 06-28-2011, 01:55 PM

Hello clint182,

Here is the updated macro. This will close the workbook if the user name and password are incorrect.

Private Sub CommandButton1_Click()

Dim username, password As String
Dim Wks As Worksheet

  username = TextBox1.Text
  password = TextBox2.Text

  Select Case TextBox1.Text
    Case Is = "Admin"
      If TextBox2.Text = "FullAccess" Then
        'Unprotect all sheets
         For Each Wks In Worksheets
           Wks.Unprotect "password"
         Next Wks
      End If
      
    Case Is = "Data Input"
      If TextBox2.Text = "Restricted" Then
        'Protect all sheets
         ProtectAllSheets
        'Unprotect Sheet1 (Master)
         Sheet1.Unprotect "password"
      End If
         
    Case Is = "Reporting"
      If TextBox2.Text = "ReadOnly" Then
        'Protect all sheets
         ProtectAllSheets
      End If
      
    Case Else
      MsgBox "You entered the WRONG info. Please try agian", vbCritical
      Unload Me
      ActiveWorkbook.Close SaveChanges:=False
  End Select
  
  Unload Me
  
End Sub