J
jwleonard
I am looking for a way to control user permissions with VBA in exce
when using "Allow Users To Edit Ranges". The bad part is I don't kno
VB!
I have some code that was written by someone and edited by me (
understand it enough to do that).
This code basically names a range on each worksheet based on th
background colors of the cells. It also locks and protects the entir
sheet but still allows editing of cells in the named range. It als
must delete and recreate the ranges everytime the file is opened t
refresh the range. However, since it deletes and recreates the range
everytime it also loses the permissions for who can edit the range
without a password. I am looking for a way to save and recreate th
same permissions each time the code runs. I have hightlighted th
changes I would like to make in red in the code below. This is not al
the code in the workbook but this is the important part for thi
operation.
Sub UsersCells()
On Error Resume Next
Dim r As Range, c As Range, rr As Range, ws As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
For Each ws In Worksheets
Set rr = Nothing
If ws.Name = "Master" Then GoTo 999
With ws
.Unprotect Password:="Leonard"
.Cells.Locked = True
Set r = .UsedRange
For Each c In r
If c.Interior.ColorIndex = 2 Or c.Interior.ColorIndex = 6 Then
If rr Is Nothing Then
Set rr = c
Else
Set rr = Union(rr, c)
End If
End If
Next c
If Not rr Is Nothing Then
ThisWorkbook.Names.Add Name:="'" & ws.Name & "'!User", RefersTo:=rr
.Protection.AllowEditRanges.Add Title:="Range1", Range:=.Range("User")
I need to make it remember the previous permissions here for Range1 o
each worksheet
.Protection.AllowEditRanges("Range1").Delete
.Protection.AllowEditRanges.Add Title:="Range1", Range:=.Range("User")
And then replace the same permissions here for Range1
rr.Cells.Locked = True
End If
.Protect Password:="Leonard", DrawingObjects:=True, Contents:=True
Scenarios:=True, userinterfaceonly:=True
End With
999
Next ws
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Su
when using "Allow Users To Edit Ranges". The bad part is I don't kno
VB!
I have some code that was written by someone and edited by me (
understand it enough to do that).
This code basically names a range on each worksheet based on th
background colors of the cells. It also locks and protects the entir
sheet but still allows editing of cells in the named range. It als
must delete and recreate the ranges everytime the file is opened t
refresh the range. However, since it deletes and recreates the range
everytime it also loses the permissions for who can edit the range
without a password. I am looking for a way to save and recreate th
same permissions each time the code runs. I have hightlighted th
changes I would like to make in red in the code below. This is not al
the code in the workbook but this is the important part for thi
operation.
Sub UsersCells()
On Error Resume Next
Dim r As Range, c As Range, rr As Range, ws As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
For Each ws In Worksheets
Set rr = Nothing
If ws.Name = "Master" Then GoTo 999
With ws
.Unprotect Password:="Leonard"
.Cells.Locked = True
Set r = .UsedRange
For Each c In r
If c.Interior.ColorIndex = 2 Or c.Interior.ColorIndex = 6 Then
If rr Is Nothing Then
Set rr = c
Else
Set rr = Union(rr, c)
End If
End If
Next c
If Not rr Is Nothing Then
ThisWorkbook.Names.Add Name:="'" & ws.Name & "'!User", RefersTo:=rr
.Protection.AllowEditRanges.Add Title:="Range1", Range:=.Range("User")
I need to make it remember the previous permissions here for Range1 o
each worksheet
.Protection.AllowEditRanges("Range1").Delete
.Protection.AllowEditRanges.Add Title:="Range1", Range:=.Range("User")
And then replace the same permissions here for Range1
rr.Cells.Locked = True
End If
.Protect Password:="Leonard", DrawingObjects:=True, Contents:=True
Scenarios:=True, userinterfaceonly:=True
End With
999
Next ws
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Su