Consulting

Results 1 to 5 of 5

Thread: Excel 2007 Unlocking Specific Cells Based on Password

  1. #1
    VBAX Newbie
    Joined
    Aug 2010
    Posts
    5
    Location

    Excel 2007 Unlocking Specific Cells Based on Password

    I am having a problem with my code to allow different users access to certain cells. When the workbook opens, the user enters their name into an inputbox, and the code grants them access to certain cells based on their level of permission. However, when they change the worksheet and save, their permissions are saved with it. If another user signs in to the workbook, they are limited to or allowed access to the cells allowed to the previous user, regardless of the new user's permission parameters.

    Here is my code:

        Dim name As String
        Dim permission As String
        Dim i As Long
        On Error Resume Next
        Application.DisplayAlerts = False
          Sheets("Calculator").Select
          Sheets("Calculator").Unprotect Password:="c"
          Range("A1:XFD65536").Locked = True
          Sheets("Calculator").Protect Password:="c"
          Sheets("Permissions").Visible = True
      For i = 1 To 3
        name = Application.InputBox("Please Enter Name", "Login", "Enter Name Here", Type:=2)
        Sheets("Permissions").Select
        If IsError(Application.Match(name, Range("A2:A65536"), 0)) Then
            Sheets("Calculator").Select
            MsgBox ("Invalid Name Entered!")
        Else
          permission = Range("A2:A65536").Find(name, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 1)
          Select Case permission
    Case "Admin": Sheets("Calculator").Select
    Case "Finance": Sheets("Calculator").Select
                    Sheets("Calculator").Unprotect Password:="c"
                    Range("D7,D8,D10,D15:D21,D23:D28,D34,D35,E12,E13,H2,H29:H33").Locked = False
                    Range("H2").Select
                    Sheets("Calculator").Protect Password:="c"
                    Sheets("Calculator").EnableSelection = xlUnlockedCells
    Case "User": Sheets("Calculator").Select
                 Sheets("Calculator").Unprotect Password:="c"
                 Range("D15:D21,D23:D28,D34,D35,E12,E13,H2,H29:H33").Locked = False
                 Range("H2").Select
                 Sheets("Calculator").Protect Password:="c"
                 Sheets("Calculator").EnableSelection = xlUnlockedCells
            End Select
            Sheets("Permissions").Visible = xlVeryHidden
          Exit Sub
        End If
      Next i
        Application.Quit

  2. #2
    Moderator VBAX Guru Simon Lloyd's Avatar
    Joined
    Sep 2005
    Location
    UK
    Posts
    3,003
    Location
    Try this in the ThisWorkbook module[VBA]Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Sheets("Calculator").Unprotect Password:="c"
    Range("A1:XFD65536").Locked = True
    Sheets("Calculator").Protect Password:="c"
    Sheets("Permissions").Visible = True
    End Sub[/VBA]
    Regards,
    Simon
    Please read this before cross posting!
    In the unlikely event you didn't get your answer here try Microsoft Office Discussion @ The Code Cage
    If I have seen further it is by standing on the shoulders of giants.
    Isaac Newton, Letter to Robert Hooke, February 5, 1675 English mathematician & physicist (1642 - 1727)

  3. #3
    VBAX Newbie
    Joined
    Aug 2010
    Posts
    5
    Location
    Even with that code, when I run the macro, no matter what user name I enter, they cannot select anything on the worksheet.

  4. #4
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  5. #5
    Moderator VBAX Guru Simon Lloyd's Avatar
    Joined
    Sep 2005
    Location
    UK
    Posts
    3,003
    Location
    pa5cal, thanks for pointing that out, CMSS Please read this before cross posting!
    Regards,
    Simon
    Please read this before cross posting!
    In the unlikely event you didn't get your answer here try Microsoft Office Discussion @ The Code Cage
    If I have seen further it is by standing on the shoulders of giants.
    Isaac Newton, Letter to Robert Hooke, February 5, 1675 English mathematician & physicist (1642 - 1727)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •