gruntingmonkey
Active Member
- Joined
- Mar 6, 2008
- Messages
- 444
- Office Version
- 365
- Platform
- Windows
I'm having a nightmare with the consistency of the below code. On some worksheets it works and others it doesn't although it doesn't fail so I have to check everything!
In the Validation Sheet, it looks up the users that should be able to access the range (which is the whole worksheet) and enters Empty if no name is given. Example is JBloggs
Does anyone have any ideas?
In the Validation Sheet, it looks up the users that should be able to access the range (which is the whole worksheet) and enters Empty if no name is given. Example is JBloggs
Code:
Sub FullPermissions()
tabname = ActiveSheet.Name
''''permissions range
Application.Calculation = xlCalculationAutomatic
Worksheets("Validation Lists").Select
Cells(2, 11).Value = tabname
If Cells(2, 12).Value <> "" Then
User1 = Cells(2, 12).Value
Else
User1 = Empty
End If
If Cells(2, 13).Value <> "" Then
User2 = Cells(2, 13).Value
Else
User2 = Empty
End If
If Cells(2, 14).Value <> "" Then
User3 = Cells(2, 14).Value
Else
User3 = Empty
End If
If Cells(2, 15).Value <> "" Then
User4 = Cells(2, 15).Value
Else
User4 = Empty
End If
If Cells(2, 16).Value <> "" Then
User5 = Cells(2, 16).Value
Else
User5 = Empty
End If
Worksheets(tabname).Select
On Error Resume Next
Set ws = ThisWorkbook.Sheets(tabname)
ws.Unprotect "locked"
ActiveSheet.Protection.AllowEditRanges(1).Delete
ActiveSheet.Protection.AllowEditRanges(2).Delete
ActiveSheet.Protection.AllowEditRanges(3).Delete
ActiveSheet.Protection.AllowEditRanges(4).Delete
ActiveSheet.Protection.AllowEditRanges(5).Delete
ActiveSheet.Protection.AllowEditRanges(6).Delete
Set aer = ws.Protection.AllowEditRanges.Add("Range1", ws.[$A:$AAA])
Set usr = aer.Users.Add(User1, True)
Set usr = aer.Users.Add(User2, True)
Set usr = aer.Users.Add(User3, True)
Set usr = aer.Users.Add(User4, True)
Set usr = aer.Users.Add(User5, True)
'sets range password
ws.Protection.AllowEditRanges(1).ChangePassword _
Password:="locked"
ws.Protect "locked"
Application.Calculation = xlCalculateManual
End Sub
Does anyone have any ideas?