Skip,
I'm not a programmer so I don't understand anything you just wrote
I found something similar on Microsoft's website, but I'm just as confused with that.
Attribute VB_Name = "Module3"
Sub ProtectMethodAllSheets()
Dim shtCurrent As Worksheet
' Loop through each worksheet in the active workbook
For Each shtCurrent In ActiveWorkbook.Worksheets
' Protect the worksheet. Allow the users to format
' and sort cells.
shtCurrent.Protect Password:="Pass", Contents:=True, _
DrawingObjects:=True, Scenarios:=True, _
AllowFormattingCells:=True, AllowSorting:=True
Next
End Sub
Sub AddEditRange()
Dim erScenarioEditRanges As AllowEditRanges
Dim erFinanceInputs As AllowEditRange
' Add an edit range to the Scenarios worksheet.
Set erFinanceInputs = _
Worksheets("Scenarios"
.Protection.AllowEditRanges.Add(Title:= _
"Finanacial Scenario Inputs", Range:=Worksheets("Scenarios"
_
.Range("E1:G15"
, Password:="ecnanif"
' Add Andrew Dixon to the list of users who can change the
' edit range. By setting the AllowEdit argument to False,
' Andrew must enter the designated password in order to make
' changes to the edit range.
erFinanceInputs.Users.Add Name:="Andrew Dixon", AllowEdit:=False
' Add Stephanie Hooper to the list of users who can change the
' edit range.
erFinanceInputs.Users.Add Name:="Stephanie Hooper", AllowEdit:=True
' Protect the Scenarios worksheet. Allow users to format and sort cells.
Worksheets("Scenarios"
.Protect Password:="OpenSesame", _
DrawingObjects:=True, _
Contents:=True, Scenarios:=True, _
AllowSorting:=True, AllowFiltering:=True
End Sub
Sub ListEditRangesAndUsers()
Dim ictr As Integer
Dim rngReportTarget As Range
Dim wbAudit As Workbook
Dim shtCurrent As Worksheet
Dim erCurrentEditRange As AllowEditRange
Dim shtReport As Worksheet
' Set a variable to the active workbook.
Set wbAudit = ActiveWorkbook
' Call a routine that sets up the report
' workbook and return a reference to the first
' worksheet in the new workbook.
Set shtReport = SetupReportSheet
' Set the initial report cell.
Set rngReportTarget = shtReport.Range("A2"
' Loop through all of the worksheets in the active workbook.
For Each shtCurrent In wbAudit.Worksheets
' Loop through each edit range in the worksheet.
For Each erCurrentEditRange In shtCurrent.Protection.AllowEditRanges
' Check to see whether any users are assigned to the Edit Range.
If erCurrentEditRange.Users.Count > 0 Then
' Loop through each user.
For ictr = 1 To erCurrentEditRange.Users.Count
' Write the edit range information for each user
' to the report worksheet
With rngReportTarget
.Value = erCurrentEditRange.Title
.Offset(0, 1).Value = shtCurrent.Name & "!" & _
erCurrentEditRange.Range.Address
.Offset(0, 2).Value = erCurrentEditRange _
.Users(ictr).Name
.Offset(0, 3).Value = erCurrentEditRange _
.Users(ictr).AllowEdit
End With
Set rngReportTarget = rngReportTarget.Offset(1, 0)
Next ictr
Else
' Write the information for edit ranges that have
' not been assigned any users to the report worksheet.
With rngReportTarget
.Value = erCurrentEditRange.Title
.Offset(0, 1).Value = shtCurrent.Name & "!" & _
erCurrentEditRange.Range.Address
.Offset(0, 2).Value = "No Users"
End With
Set rngReportTarget = rngReportTarget.Offset(1, 0)
End If
Next erCurrentEditRange
Next shtCurrent
End Sub
Function SetupReportSheet() As Worksheet
Dim shtReport As Worksheet
Set shtReport = Workbooks.Add.Worksheets("sheet1"
With shtReport
.Range("A1"
.Value = "Range Title"
.Range("B1"
.Value = "Address"
.Range("C1"
.Value = "User Name"
.Range("D1"
.Value = "Edit Without Password?"
.Range("A1
1"
.Font.Bold = True
End With
Set SetupReportSheet = shtReport
End Function
