Protect/Unprotect Sheets Macro

[burns14hs]

Hello All -

I have a workbook with 35 sheets on a shared drive at work. Recently someone deleted things they weren't supposed to and all hell broke loose. After unlocking all the cells the user should be using I would like to find a code that does the following if possible:

1. Protects all sheets automatically on open with the same password regardless of the status of those sheets the last time they were exited.
2. If the person in charge of maintaining the file unprotects a sheet with a correct password, automatically unprotect all sheets in the workbook.

I believe the below code should protect the sheets on open if I make an original With statement for each sheet and still allow users to be able to access the group/ungroup buttons. Am I correct here for item 1 on the list, or am I off on something?

Private Sub Workbook_Open()
With Sheet1
.Protect Password:="password", UserInterfaceOnly:=True
.EnableOutlining = True
End With
End Sub
#2 on the list I'm completely lost on, however. Any help here would be most appreciated.

 

[Urtehnoes]

The username part works magically, I have yet to test out the GroupColumns sub because I didn't wanna test too much stuff at once. I can't even begin to find enough words to thank you! One final question, however... if I want to give access to 2 users (myself and 1 other) do I need to incorporate an Or statement after PWord =?

Yes! If you're going to compare more than one person, than the set up changes a little bit, but the overall intention is the same.
In the ones I list below, I'll define a password "Guest" or what have you, and then I compare the User's login with a list of acceptable logins I have in my code. If they match, I'll turn a Boolean Flag to True and unprotect the sheets using the password "Guest" if not, the Workbook is locked up with UserIntefaceOnly =True, which will still allow VBA to Group/Ungroup Columns.



StrComp, aka string comparison, returns 0 if String2 is found completely in String1, so we just just turn it into an If...Then statement:

Old:

Login = Environ("UserName")
PWord = "ENTER YOUR NETWORK/COMPUTER LOGIN (NOT PASS) HERE"
[FONT=Verdana]StrComp(Login, PWord) = 0 Then AdminAccess = True 
[/FONT]

New: (If you're just adding a 2nd person)

Login = Environ("UserName")
PWord = "ENTER YOUR NETWORK/COMPUTER LOGIN (NOT PASS) HERE"
[FONT=Verdana]If StrComp(Login, PWord) = 0 Then 
   AdminAccess = True 
Else
   PwordTwo = "2ndPersonsLogon"
   If StrComp(Login,PwordTwo) = 0 Then AdminAccess = True
End If
[/FONT]

Or if you're adding a few people:
(Note that Admin Access defaults to True... Not False.. Because I'm lazy.)

Login = Environ("UserName")PWord = "Guest123"
AdminAccess = True


Select Case Login
Case "PERSON A'S LOGIN"
Case "PERSON B'S LOGIN"
Case "PERSON C'S LOGIN"
Case "PERSON D'S LOGIN"
Case Else
    AdminAccess = False
End Select


For i = 1 To WkBk.Sheets.Count
  If AdminAccess = False Then
    Sheets(i).Protect Password:=PWord, UserInterfaceOnly:=True
 Else
    Sheets(i).Unprotect Password:=PWord
 End If
Next i

Lastly, while I'm copying pasting codes from my Personal.xlsb... This one is handy if you need need to offer different levels of Security 'clearance' to a person. (Say AdminAccess = True gives you everything, while BossAccess gives you access to somethings.)
What it does, is simply compares the user's login with every name in the first array (note each array has the same amount of elements, aka usernames or "".
Once / If it finds the user's login in the list of Admin arrays, it saves the position (i) and then goes and on to test if it should flag Boss / Admin Access to True, or leave as false.

Private Sub StartAutomatedReport(AdminLoginArr As Variant, BossLoginArr As Variant, ExcelDestroyerArr As Variant, i As Long)
Dim AdminAccess As Boolean
Dim BossAccess As Boolean
Dim NoAccessEver As Boolean


UserName = Environ("UserName")
AdminLoginArr = Array("Bob", "Joe", "Sue", "Kelly", "Dave", "", "Alex")
BossLoginArr = Array("Bob", "", "", "Kelly", "Dave", "Christine", "Alex")
ExcelDestroyerArr = Array("", "", "", "", "", "", "", "Alex")    '<- Alex destroys spreadsheets. We don't allow him in at all :|


Call DetermineStatus(UserName, AdminLoginArr, i)    'This is a function.. Not a sub

On Error Resume Next
If BossLoginArr(i) <> vbNullString Then
    If AdminLoginArr(i) <> vbNullString Then
        AdminAccess = True
        BossAccess = True
    Else
        AdminAccess = False
        BossAccess = True
    End If
End If
If ExcelDestroyerArr(i) <> vbNullString Then
    MsgBox "Alex - Please ask for assistance before continuing, thanks!"
    ActiveWorkbook.Close Savechanges:=False
End If
On Error Goto 0

For i = 1 To WkBk.Sheets.Count
    If AdminAccess = False Then
        'BossAccess will let them do a little.. but not a lot.
        If BossAccess = True Then Sheets(i).Protect Password:=PWord, AllowCellFormatting:=True, AllowInsertRows:=True, AllowInsertColumns:=True
    End If
Else
    'Application.StatusBar displays at the bottom of Workbook. My WkBk has a CloseEvent that resets it to "" (normal)
    Sheets(i).Protect Password:=PWord, UserInterfaceOnly:=True
    Application.StatusBar "Attention User: You do not have privileges to edit this worksheet. Please see Me if you would like said privileges."
Else
    'AdminAccess gives them everything.
    Sheets(i).Unprotect Password:=PWord
End If
Next i
End Sub
Function DetermineStatus(UserName As String, AdminLoginArr As Variant, i As Long) As Long


DetermineStatus = -1
'This returns the requested username position, if it's found in the array.


For i = LBound(AdminLoginArr) To UBound(AdminLoginArr)
    If StrComp(UserName, AdminLoginArr(i), vbTextCompare) = 0 Then
        DetermineStatus = i
        Exit For
    End If
Next i
End Function

 

[burns14hs]

Urtehnoes, if you're still around, I encountered a problem today after it was all working smoothly yesterday...

I created this on a small personal drive on my work computer and everything worked fine. I emailed it to the other 2 users and it also worked fine for them. However, when I put it onto the shared network drive, it now errors out with: Run-time error '1004': The password you supplied is not correct. Verify that the CAPS LOCK key is off and be sure to use the correct capitalization.

On "Debug" it highlights what I put in Red below...

Being that the password is just the username and it's granting access based on if your user name is one of the three approved, I'm not sure why it's having a problem. If it didn't match the username, it should just protect the sheets and continue. Does anybody have any thoughts as to the problem caused by the shared location and how to fix it?

Dim i As Long
Dim WkBk As Workbook
Dim Login As String
Dim PWord As String
Dim AdminAccess As Boolean
Set WkBk = ActiveWorkbook'Environ("UserName") grabs the login name attached to your profile on your computer.
Login = Environ("UserName")
PWord = "jburns1"
PWord1 = "lsmith7"
PWord2 = "rkriston"
If StrComp(Login, PWord) = 0 Then AdminAccess = True
If StrComp(Login, PWord1) = 0 Then AdminAccess = True
If StrComp(Login, PWord2) = 0 Then AdminAccess = True
For i = 1 To WkBk.Sheets.Count
If AdminAccess = False Then
Sheets(i).Protect Password:=PWord, UserInterfaceOnly:=True
Sheets(i).EnableOutlining = True
Else
Sheets(i).Unprotect Password:=PWord
End If
Next i

 

[Urtehnoes]

Yeah... Putting it on the Network really should have no effect.
The only thing that comes to me immediately is that someone changed the password when they protected it, say editing the code to be .Protect Password:=Pword1 - so now only Pword1 would access it. Depending on where the other users are, ask if they can access it on the Network as well. (perhaps by accident?).

What you can also do to try and troubleshoot that, is to open up the Wkbk, and create a new tab and move it to the front. Protect it with the pword = "jburns1" and save and close the workbook. Open it back up again, and if you still get the error, check to see if the first worksheet is still protected or not (on the network of course).