Building a VBA-Powered Workbook Protection Manager: Programmatically Lock, Unlock, and Audit Cell Ranges, Sheet Permissions, and Password Policies Across Enterprise Workbooks

Introduction

Picture this: your finance team maintains 47 Excel workbooks across three regional offices. Each one contains a mix of input cells for local data entry, formula ranges that must never be touched, and summary sheets that only senior analysts should see. Every quarter, a new analyst joins and needs access adjusted. Every month, someone emails you because they "accidentally deleted a formula." And twice this year, a critical workbook was broken because someone changed a protection password without telling anyone — and then left the company.

This is the reality of enterprise Excel environments. Protection in Excel is not just a feature — it's a governance problem. The built-in tools are fine for a single workbook maintained by one person, but they fall apart the moment you need to enforce consistent policies across dozens of files, audit who can edit what, or roll out a password change to a fleet of workbooks without opening each one individually.

By the end of this lesson, you will have built a fully functional VBA Protection Manager: a suite of procedures that programmatically controls cell-level locking, sheet-level permissions, and workbook structure protection, plus an audit engine that reports the current protection state of every sheet and range in a workbook — all driven from a central configuration approach that can scale to as many workbooks as your organization maintains.

What you'll learn:

• How Excel's protection model actually works at the object level, and why the order of operations matters critically
• How to programmatically lock and unlock specific cell ranges with granular per-user permissions
• How to apply, remove, and rotate sheet protection passwords across multiple workbooks in batch
• How to build an audit procedure that generates a structured protection inventory report
• How to design a reusable, enterprise-grade protection policy system driven by configuration data

---

Prerequisites

This lesson assumes you are comfortable with VBA fundamentals. You should know how to open the VBA editor, write and run Sub procedures, and work with basic objects like Workbook, Worksheet, and Range. If you need to catch up, work through Working with Ranges, Cells, and Worksheets in VBA for Data Professionals and Writing VBA Procedures and Functions: Subs, Functions, and Scope Explained for Excel Automation before continuing.

You should also be familiar with error handling patterns — this lesson uses On Error extensively, and understanding why we structure error handling the way we do will help you adapt these procedures to your own workbooks. Error Handling and Debugging VBA Code Like a Pro covers the patterns we rely on here.

---

Understanding Excel's Protection Architecture

Before we write a single line of code, we need to understand what we're actually controlling. Excel has three distinct protection layers, and they interact in ways that surprise even experienced users.

Layer 1: Cell-level locking. Every cell in Excel has a Locked property (and an optional FormulaHidden property). By default, every cell in a new workbook has Locked = True. This surprises people. The key insight is that cell locking has no effect until sheet protection is active. Locking a cell without protecting the sheet is like putting a lock on a door with no walls — the lock is there, but it does nothing.

Layer 2: Sheet protection. When you protect a worksheet (Worksheet.Protect), Excel enforces the Locked property on every cell. Users can only edit cells where Locked = False. Sheet protection also controls a long list of other permissions: whether users can select locked cells, format columns, insert rows, use AutoFilter, and so on. There are 16 distinct Boolean parameters on the Protect method.

Layer 3: Workbook structure protection. This is separate from sheet protection. Workbook.Protect prevents users from adding, deleting, moving, or renaming sheets. It does not protect cell content — that's the sheet's job.

There's also a subtler issue: AllowEditRanges. This is a collection on the Worksheet object that lets you define specific ranges that particular users (or anyone with a range-specific password) can edit even while the sheet is protected. This is the enterprise-grade feature that most VBA tutorials completely ignore, and it's central to our design.

---

Designing the Protection Policy Architecture

Rather than hardcoding protection rules into each procedure, we'll drive our system from a configuration sheet. This is the architectural decision that separates a one-off script from a maintainable enterprise tool.

Create a new worksheet in your manager workbook named ProtectionPolicy. Set it up with these columns:

• Column A: WorkbookPath — full path to the target workbook
• Column B: SheetName — name of the worksheet to configure
• Column C: RangeAddress — the cell range to configure (e.g., B2:B50, D:D)
• Column D: LockState — LOCKED or UNLOCKED
• Column E: AllowEditTitle — a name for an AllowEditRange (leave blank if not applicable)
• Column F: AllowEditPassword — password for the AllowEditRange (optional)
• Column G: SheetPassword — the password used to protect the sheet
• Column H: AllowSelectLocked — TRUE or FALSE
• Column I: AllowSort — TRUE or FALSE
• Column J: AllowFilter — TRUE or FALSE

A second sheet named AuditLog will hold the output from our audit procedures.

This configuration-driven design means you can add a new workbook to your managed fleet simply by adding rows to ProtectionPolicy. No code changes required.

---

Building the Core Protection Utilities

Let's build the foundational procedures first, then assemble them into higher-level operations. Create a standard module named modProtectionCore.

Option Explicit

' ============================================================
' modProtectionCore
' Core utility procedures for the Protection Manager
' ============================================================

' Safely unprotect a worksheet, returning True on success
Public Function UnprotectSheet(ws As Worksheet, sPassword As String) As Boolean
    On Error GoTo ErrHandler
    
    If ws.ProtectContents Then
        ws.Unprotect Password:=sPassword
    End If
    UnprotectSheet = True
    Exit Function
    
ErrHandler:
    ' Wrong password or structural issue
    Debug.Print "UnprotectSheet failed for [" & ws.Name & "]: " & Err.Description
    UnprotectSheet = False
End Function

' Protect a worksheet with a comprehensive permission set
Public Function ProtectSheet( _
    ws As Worksheet, _
    sPassword As String, _
    bAllowSelectLocked As Boolean, _
    bAllowSort As Boolean, _
    bAllowFilter As Boolean, _
    Optional bAllowFormatCells As Boolean = False, _
    Optional bAllowInsertRows As Boolean = False, _
    Optional bAllowDeleteRows As Boolean = False _
) As Boolean
    On Error GoTo ErrHandler
    
    ws.Protect _
        Password:=sPassword, _
        DrawingObjects:=True, _
        Contents:=True, _
        Scenarios:=True, _
        AllowFormattingCells:=bAllowFormatCells, _
        AllowFormattingColumns:=False, _
        AllowFormattingRows:=False, _
        AllowInsertingColumns:=False, _
        AllowInsertingRows:=bAllowInsertRows, _
        AllowInsertingHyperlinks:=False, _
        AllowDeletingColumns:=False, _
        AllowDeletingRows:=bAllowDeleteRows, _
        AllowSorting:=bAllowSort, _
        AllowFiltering:=bAllowFilter, _
        AllowUsingPivotTables:=False, _
        UserInterfaceOnly:=True
    
    ProtectSheet = True
    Exit Function
    
ErrHandler:
    Debug.Print "ProtectSheet failed for [" & ws.Name & "]: " & Err.Description
    ProtectSheet = False
End Function

' Set the Locked property for a range (sheet must be unprotected)
Public Function SetRangeLock( _
    ws As Worksheet, _
    sRangeAddress As String, _
    bLocked As Boolean _
) As Boolean
    On Error GoTo ErrHandler
    
    Dim rng As Range
    Set rng = ws.Range(sRangeAddress)
    rng.Locked = bLocked
    SetRangeLock = True
    Exit Function
    
ErrHandler:
    Debug.Print "SetRangeLock failed - Range [" & sRangeAddress & "] on [" & _
                ws.Name & "]: " & Err.Description
    SetRangeLock = False
End Function

' Register an AllowEditRange on a protected sheet
Public Function AddAllowEditRange( _
    ws As Worksheet, _
    sTitle As String, _
    sRangeAddress As String, _
    sRangePassword As String, _
    sSheetPassword As String _
) As Boolean
    On Error GoTo ErrHandler
    
    Dim aer As AllowEditRange
    
    ' Check if this named range already exists and remove it
    Dim existingAER As AllowEditRange
    For Each existingAER In ws.Protection.AllowEditRanges
        If existingAER.Title = sTitle Then
            existingAER.Delete
            Exit For
        End If
    Next existingAER
    
    ' Sheet must be unprotected to modify AllowEditRanges
    Call UnprotectSheet(ws, sSheetPassword)
    
    Set aer = ws.Protection.AllowEditRanges.Add( _
        Title:=sTitle, _
        Range:=ws.Range(sRangeAddress), _
        Password:=sRangePassword _
    )
    
    AddAllowEditRange = True
    Exit Function
    
ErrHandler:
    Debug.Print "AddAllowEditRange failed - [" & sTitle & "] on [" & _
                ws.Name & "]: " & Err.Description
    AddAllowEditRange = False
End Function

Notice the UserInterfaceOnly:=True parameter in ProtectSheet. This is one of the most important — and underused — parameters in Excel's protection model. When set to True, sheet protection applies only to the user interface. VBA code running in the same session can still modify the sheet freely, without needing to unprotect and re-protect around every operation. This eliminates a massive amount of boilerplate in your automation code.

---

The Batch Policy Application Engine

Now we build the engine that reads the ProtectionPolicy sheet and applies all configured rules. This is the workhorse of the entire system. Add a new module named modPolicyEngine.

Option Explicit

' ============================================================
' modPolicyEngine
' Reads ProtectionPolicy sheet and applies rules to target workbooks
' ============================================================

Public Sub ApplyAllPolicies()
    
    Dim wbManager As Workbook
    Dim wsPolicy As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    Set wbManager = ThisWorkbook
    Set wsPolicy = wbManager.Sheets("ProtectionPolicy")
    lastRow = wsPolicy.Cells(wsPolicy.Rows.Count, "A").End(xlUp).Row
    
    If lastRow < 2 Then
        MsgBox "No policy rows found. Add configuration data starting at row 2.", _
               vbInformation, "Protection Manager"
        Exit Sub
    End If
    
    ' Group rows by workbook path for efficient processing
    Dim dictWorkbooks As Object
    Set dictWorkbooks = CreateObject("Scripting.Dictionary")
    
    For i = 2 To lastRow
        Dim sWBPath As String
        sWBPath = Trim(wsPolicy.Cells(i, "A").Value)
        If sWBPath <> "" Then
            If Not dictWorkbooks.Exists(sWBPath) Then
                dictWorkbooks.Add sWBPath, i
            End If
        End If
    Next i
    
    ' Process each unique workbook
    Dim vKey As Variant
    Dim nSucceeded As Integer
    Dim nFailed As Integer
    
    For Each vKey In dictWorkbooks.Keys
        If ApplyPoliciesForWorkbook(CStr(vKey), wsPolicy, lastRow) Then
            nSucceeded = nSucceeded + 1
        Else
            nFailed = nFailed + 1
        End If
    Next vKey
    
    MsgBox "Policy application complete." & vbCrLf & _
           "Workbooks succeeded: " & nSucceeded & vbCrLf & _
           "Workbooks failed: " & nFailed, _
           vbInformation, "Protection Manager"
End Sub

Private Function ApplyPoliciesForWorkbook( _
    sWBPath As String, _
    wsPolicy As Worksheet, _
    lastRow As Long _
) As Boolean
    
    On Error GoTo ErrHandler
    
    Dim wbTarget As Workbook
    Dim bOpenedByUs As Boolean
    
    ' Open the workbook if not already open
    bOpenedByUs = False
    On Error Resume Next
    Set wbTarget = Workbooks(Dir(sWBPath))
    On Error GoTo ErrHandler
    
    If wbTarget Is Nothing Then
        If Dir(sWBPath) = "" Then
            LogAuditEvent "ERROR", sWBPath, "N/A", "N/A", _
                          "File not found: " & sWBPath
            ApplyPoliciesForWorkbook = False
            Exit Function
        End If
        Set wbTarget = Workbooks.Open(sWBPath, ReadOnly:=False, UpdateLinks:=False)
        bOpenedByUs = True
    End If
    
    ' Process each policy row that applies to this workbook
    Dim i As Long
    Dim wsTarget As Worksheet
    Dim sSheetName As String
    Dim sLastSheet As String
    Dim sSheetPassword As String
    
    sLastSheet = ""
    
    For i = 2 To lastRow
        If Trim(wsPolicy.Cells(i, "A").Value) <> sWBPath Then GoTo NextRow
        
        sSheetName = Trim(wsPolicy.Cells(i, "B").Value)
        Dim sRangeAddress As String
        Dim sLockState As String
        Dim sAllowEditTitle As String
        Dim sAllowEditPassword As String
        Dim bAllowSelectLocked As Boolean
        Dim bAllowSort As Boolean
        Dim bAllowFilter As Boolean
        
        sRangeAddress    = Trim(wsPolicy.Cells(i, "C").Value)
        sLockState       = UCase(Trim(wsPolicy.Cells(i, "D").Value))
        sAllowEditTitle  = Trim(wsPolicy.Cells(i, "E").Value)
        sAllowEditPassword = Trim(wsPolicy.Cells(i, "F").Value)
        sSheetPassword   = Trim(wsPolicy.Cells(i, "G").Value)
        bAllowSelectLocked = (UCase(Trim(wsPolicy.Cells(i, "H").Value)) = "TRUE")
        bAllowSort       = (UCase(Trim(wsPolicy.Cells(i, "I").Value)) = "TRUE")
        bAllowFilter     = (UCase(Trim(wsPolicy.Cells(i, "J").Value)) = "TRUE")
        
        ' Get the target sheet
        On Error Resume Next
        Set wsTarget = wbTarget.Sheets(sSheetName)
        On Error GoTo ErrHandler
        
        If wsTarget Is Nothing Then
            LogAuditEvent "WARNING", sWBPath, sSheetName, sRangeAddress, _
                          "Sheet not found"
            GoTo NextRow
        End If
        
        ' If we're moving to a new sheet, unprotect it first
        If sSheetName <> sLastSheet Then
            If Not UnprotectSheet(wsTarget, sSheetPassword) Then
                LogAuditEvent "ERROR", sWBPath, sSheetName, "N/A", _
                              "Failed to unprotect sheet (wrong password?)"
                GoTo NextRow
            End If
            sLastSheet = sSheetName
        End If
        
        ' Apply the cell lock state
        If sRangeAddress <> "" And sLockState <> "" Then
            Dim bLocked As Boolean
            bLocked = (sLockState = "LOCKED")
            
            If Not SetRangeLock(wsTarget, sRangeAddress, bLocked) Then
                LogAuditEvent "ERROR", sWBPath, sSheetName, sRangeAddress, _
                              "Failed to set lock state to " & sLockState
            Else
                LogAuditEvent "SUCCESS", sWBPath, sSheetName, sRangeAddress, _
                              "Lock state set to " & sLockState
            End If
        End If
        
        ' Register AllowEditRange if specified
        If sAllowEditTitle <> "" And sRangeAddress <> "" Then
            If Not AddAllowEditRange(wsTarget, sAllowEditTitle, sRangeAddress, _
                                     sAllowEditPassword, sSheetPassword) Then
                LogAuditEvent "ERROR", sWBPath, sSheetName, sRangeAddress, _
                              "Failed to add AllowEditRange: " & sAllowEditTitle
            Else
                LogAuditEvent "SUCCESS", sWBPath, sSheetName, sRangeAddress, _
                              "AllowEditRange registered: " & sAllowEditTitle
            End If
        End If
        
NextRow:
        Set wsTarget = Nothing
    Next i
    
    ' Re-protect all sheets that were modified
    ' We track this by iterating sheets that appear in policy for this workbook
    Dim wsReprotect As Worksheet
    Dim sSheetsProcessed As String
    sSheetsProcessed = ""
    
    For i = 2 To lastRow
        If Trim(wsPolicy.Cells(i, "A").Value) <> sWBPath Then GoTo NextReprotect
        sSheetName = Trim(wsPolicy.Cells(i, "B").Value)
        sSheetPassword = Trim(wsPolicy.Cells(i, "G").Value)
        bAllowSelectLocked = (UCase(Trim(wsPolicy.Cells(i, "H").Value)) = "TRUE")
        bAllowSort = (UCase(Trim(wsPolicy.Cells(i, "I").Value)) = "TRUE")
        bAllowFilter = (UCase(Trim(wsPolicy.Cells(i, "J").Value)) = "TRUE")
        
        ' Only re-protect each sheet once
        If InStr("|" & sSheetsProcessed & "|", "|" & sSheetName & "|") = 0 Then
            On Error Resume Next
            Set wsReprotect = wbTarget.Sheets(sSheetName)
            On Error GoTo ErrHandler
            
            If Not wsReprotect Is Nothing Then
                If Not ProtectSheet(wsReprotect, sSheetPassword, _
                                    bAllowSelectLocked, bAllowSort, bAllowFilter) Then
                    LogAuditEvent "ERROR", sWBPath, sSheetName, "N/A", _
                                  "Failed to re-protect sheet"
                Else
                    LogAuditEvent "SUCCESS", sWBPath, sSheetName, "N/A", _
                                  "Sheet re-protected successfully"
                End If
                sSheetsProcessed = sSheetsProcessed & "|" & sSheetName
            End If
        End If
        
NextReprotect:
        Set wsReprotect = Nothing
    Next i
    
    ' Save and optionally close
    wbTarget.Save
    If bOpenedByUs Then wbTarget.Close SaveChanges:=False
    
    ApplyPoliciesForWorkbook = True
    Exit Function
    
ErrHandler:
    LogAuditEvent "ERROR", sWBPath, "N/A", "N/A", _
                  "Unexpected error: " & Err.Number & " - " & Err.Description
    If bOpenedByUs And Not wbTarget Is Nothing Then
        wbTarget.Close SaveChanges:=False
    End If
    ApplyPoliciesForWorkbook = False
End Function

This engine handles the case where your policy sheet has multiple rows for the same sheet — each row configures one range — and it correctly unprotects the sheet once, applies all range configurations, then re-protects. The sSheetsProcessed string tracker prevents double-protecting sheets.

---

Building the Audit Engine

The audit engine is arguably more valuable than the policy application engine in day-to-day operations. It answers the question: "What is the actual protection state of this workbook right now?" — which is essential for compliance reviews and debugging.

Add a new module named modAuditEngine.

Option Explicit

' ============================================================
' modAuditEngine
' Generates a structured protection inventory report
' ============================================================

Public Sub AuditWorkbook(Optional sTargetPath As String = "")
    
    Dim wbTarget As Workbook
    Dim bOpenedByUs As Boolean
    Dim wsAudit As Worksheet
    
    ' If no path provided, audit the active workbook
    If sTargetPath = "" Then
        Set wbTarget = ActiveWorkbook
        bOpenedByUs = False
    Else
        If Dir(sTargetPath) = "" Then
            MsgBox "File not found: " & sTargetPath, vbCritical
            Exit Sub
        End If
        On Error Resume Next
        Set wbTarget = Workbooks(Dir(sTargetPath))
        On Error GoTo 0
        If wbTarget Is Nothing Then
            Set wbTarget = Workbooks.Open(sTargetPath, ReadOnly:=True, UpdateLinks:=False)
            bOpenedByUs = True
        End If
    End If
    
    ' Prepare the audit output sheet
    Set wsAudit = PrepareAuditSheet()
    
    ' Write workbook-level information
    Dim nextRow As Long
    nextRow = wsAudit.Cells(wsAudit.Rows.Count, "A").End(xlUp).Row + 1
    
    With wsAudit
        .Cells(nextRow, 1).Value = Now()
        .Cells(nextRow, 2).Value = wbTarget.FullName
        .Cells(nextRow, 3).Value = "WORKBOOK"
        .Cells(nextRow, 4).Value = "N/A"
        .Cells(nextRow, 5).Value = "N/A"
        .Cells(nextRow, 6).Value = IIf(wbTarget.ProtectStructure, "PROTECTED", "UNPROTECTED")
        .Cells(nextRow, 7).Value = IIf(wbTarget.ProtectWindows, "WINDOWS LOCKED", "")
        .Cells(nextRow, 1).EntireRow.Interior.Color = RGB(230, 242, 255)
    End With
    nextRow = nextRow + 1
    
    ' Audit each worksheet
    Dim ws As Worksheet
    For Each ws In wbTarget.Worksheets
        nextRow = AuditWorksheet(ws, wsAudit, nextRow, wbTarget.FullName)
    Next ws
    
    ' Auto-fit columns for readability
    wsAudit.Columns("A:G").AutoFit
    
    If bOpenedByUs Then wbTarget.Close SaveChanges:=False
    
    wsAudit.Activate
    MsgBox "Audit complete. " & (nextRow - 3) & " items inventoried.", _
           vbInformation, "Protection Audit"
End Sub

Private Function AuditWorksheet( _
    ws As Worksheet, _
    wsAudit As Worksheet, _
    startRow As Long, _
    sWBPath As String _
) As Long
    
    Dim nextRow As Long
    nextRow = startRow
    
    ' Sheet-level protection summary
    With wsAudit
        .Cells(nextRow, 1).Value = Now()
        .Cells(nextRow, 2).Value = sWBPath
        .Cells(nextRow, 3).Value = ws.Name
        .Cells(nextRow, 4).Value = "SHEET"
        .Cells(nextRow, 5).Value = "N/A"
        
        If ws.ProtectContents Then
            .Cells(nextRow, 6).Value = "PROTECTED"
            Dim permSummary As String
            permSummary = BuildPermissionSummary(ws)
            .Cells(nextRow, 7).Value = permSummary
            .Cells(nextRow, 1).EntireRow.Interior.Color = RGB(255, 242, 204)
        Else
            .Cells(nextRow, 6).Value = "UNPROTECTED"
            .Cells(nextRow, 1).EntireRow.Interior.Color = RGB(255, 230, 230)
        End If
    End With
    nextRow = nextRow + 1
    
    ' AllowEditRanges inventory
    If ws.ProtectContents Then
        Dim aer As AllowEditRange
        For Each aer In ws.Protection.AllowEditRanges
            With wsAudit
                .Cells(nextRow, 1).Value = Now()
                .Cells(nextRow, 2).Value = sWBPath
                .Cells(nextRow, 3).Value = ws.Name
                .Cells(nextRow, 4).Value = "ALLOW_EDIT_RANGE"
                .Cells(nextRow, 5).Value = aer.Range.Address
                .Cells(nextRow, 6).Value = aer.Title
                .Cells(nextRow, 7).Value = IIf(aer.Users.Count > 0, _
                    "Users: " & aer.Users.Count, "Password protected")
            End With
            nextRow = nextRow + 1
        Next aer
    End If
    
    ' Scan for ranges with non-default lock state
    ' Default: all cells locked. Report any that deviate.
    nextRow = AuditCellLockStates(ws, wsAudit, nextRow, sWBPath)
    
    AuditWorksheet = nextRow
End Function

Private Function BuildPermissionSummary(ws As Worksheet) As String
    Dim parts() As String
    Dim count As Integer
    count = 0
    ReDim parts(10)
    
    If ws.Protection.AllowFormattingCells Then
        parts(count) = "FormatCells"
        count = count + 1
    End If
    If ws.Protection.AllowInsertingRows Then
        parts(count) = "InsertRows"
        count = count + 1
    End If
    If ws.Protection.AllowDeletingRows Then
        parts(count) = "DeleteRows"
        count = count + 1
    End If
    If ws.Protection.AllowSorting Then
        parts(count) = "Sort"
        count = count + 1
    End If
    If ws.Protection.AllowFiltering Then
        parts(count) = "Filter"
        count = count + 1
    End If
    If ws.Protection.AllowUsingPivotTables Then
        parts(count) = "PivotTables"
        count = count + 1
    End If
    
    If count = 0 Then
        BuildPermissionSummary = "All permissions restricted"
    Else
        ReDim Preserve parts(count - 1)
        BuildPermissionSummary = "Allowed: " & Join(parts, ", ")
    End If
End Function

Private Function AuditCellLockStates( _
    ws As Worksheet, _
    wsAudit As Worksheet, _
    startRow As Long, _
    sWBPath As String _
) As Long
    
    ' We use SpecialCells to efficiently find locked and unlocked ranges
    ' rather than iterating every cell (which would be catastrophically slow)
    
    Dim rngLocked As Range
    Dim rngUnlocked As Range
    Dim nextRow As Long
    nextRow = startRow
    
    On Error Resume Next
    
    ' Find all unlocked cells (the interesting deviation from default)
    rngUnlocked = ws.Cells.SpecialCells(xlCellTypeAllFormatConditions)
    
    ' SpecialCells approach for locked status requires a different technique
    ' We use the xlCellTypeBlanks trick - instead, we'll check used range areas
    
    ' Reset error handling
    Err.Clear
    On Error Resume Next
    
    Set rngUnlocked = Nothing
    Set rngLocked = Nothing
    
    ' Check if the used range has any unlocked cells
    Dim usedRng As Range
    Set usedRng = ws.UsedRange
    
    If usedRng Is Nothing Then
        AuditCellLockStates = nextRow
        Exit Function
    End If
    
    ' Use a helper to find contiguous locked/unlocked blocks
    Dim cellArea As Range
    Dim sUnlockedAddresses As String
    Dim sLockedAddresses As String
    Dim bCurrentLock As Boolean
    Dim rngSameState As Range
    
    ' For performance, work area by area within the used range
    Dim cell As Range
    Dim prevLock As Integer ' -1 = uninitialised, 0 = unlocked, 1 = locked
    prevLock = -1
    
    For Each cell In usedRng.Cells
        bCurrentLock = cell.Locked
        If bCurrentLock Then
            sLockedAddresses = sLockedAddresses & IIf(sLockedAddresses = "", "", ", ") & _
                               cell.Address(False, False)
        Else
            sUnlockedAddresses = sUnlockedAddresses & _
                                 IIf(sUnlockedAddresses = "", "", ", ") & _
                                 cell.Address(False, False)
        End If
    Next cell
    
    On Error GoTo 0
    
    ' Write summary to audit sheet
    If sUnlockedAddresses <> "" Then
        With wsAudit
            .Cells(nextRow, 1).Value = Now()
            .Cells(nextRow, 2).Value = sWBPath
            .Cells(nextRow, 3).Value = ws.Name
            .Cells(nextRow, 4).Value = "UNLOCKED_CELLS"
            .Cells(nextRow, 5).Value = Left(sUnlockedAddresses, 500) & _
                                       IIf(Len(sUnlockedAddresses) > 500, "...", "")
            .Cells(nextRow, 6).Value = "UNLOCKED"
            .Cells(nextRow, 7).Value = "User-editable when sheet is protected"
        End With
        nextRow = nextRow + 1
    End If
    
    AuditCellLockStates = nextRow
End Function

---

Password Rotation Across a Workbook Fleet

One of the most painful tasks in enterprise Excel management is rotating passwords. Someone leaves the team, or your security policy requires quarterly rotation, and you need to update protection passwords across dozens of workbooks without manually opening each one.

Add this to a module named modPasswordRotation.

Option Explicit

' ============================================================
' modPasswordRotation
' Batch password rotation across managed workbooks
' ============================================================

Public Sub RotateSheetPasswords( _
    sOldPassword As String, _
    sNewPassword As String, _
    Optional sTargetWorkbookPath As String = "" _
)
    ' Rotates protection password on all sheets in target workbook(s)
    ' If sTargetWorkbookPath is empty, rotates across ALL workbooks in policy
    
    Dim wsPolicy As Worksheet
    Set wsPolicy = ThisWorkbook.Sheets("ProtectionPolicy")
    
    Dim lastRow As Long
    lastRow = wsPolicy.Cells(wsPolicy.Rows.Count, "A").End(xlUp).Row
    
    Dim i As Long
    Dim dictWBs As Object
    Set dictWBs = CreateObject("Scripting.Dictionary")
    
    For i = 2 To lastRow
        Dim sPath As String
        sPath = Trim(wsPolicy.Cells(i, "A").Value)
        If sPath <> "" Then
            If sTargetWorkbookPath = "" Or sPath = sTargetWorkbookPath Then
                If Not dictWBs.Exists(sPath) Then
                    dictWBs.Add sPath, True
                End If
            End If
        End If
    Next i
    
    Dim nRotated As Integer
    Dim nFailed As Integer
    Dim vKey As Variant
    
    For Each vKey In dictWBs.Keys
        If RotatePasswordsInWorkbook(CStr(vKey), sOldPassword, sNewPassword) Then
            nRotated = nRotated + 1
            ' Update the policy sheet to reflect new password
            UpdatePolicyPassword wsPolicy, CStr(vKey), sOldPassword, sNewPassword
        Else
            nFailed = nFailed + 1
        End If
    Next vKey
    
    MsgBox "Password rotation complete." & vbCrLf & _
           "Workbooks updated: " & nRotated & vbCrLf & _
           "Failures: " & nFailed, vbInformation, "Password Rotation"
End Sub

Private Function RotatePasswordsInWorkbook( _
    sPath As String, _
    sOldPassword As String, _
    sNewPassword As String _
) As Boolean
    
    On Error GoTo ErrHandler
    
    Dim wbTarget As Workbook
    Dim bOpenedByUs As Boolean
    
    If Dir(sPath) = "" Then
        LogAuditEvent "ERROR", sPath, "N/A", "N/A", "File not found during password rotation"
        RotatePasswordsInWorkbook = False
        Exit Function
    End If
    
    On Error Resume Next
    Set wbTarget = Workbooks(Dir(sPath))
    On Error GoTo ErrHandler
    
    If wbTarget Is Nothing Then
        Set wbTarget = Workbooks.Open(sPath, ReadOnly:=False, UpdateLinks:=False)
        bOpenedByUs = True
    End If
    
    Dim ws As Worksheet
    Dim nSheetsFailed As Integer
    nSheetsFailed = 0
    
    For Each ws In wbTarget.Worksheets
        If ws.ProtectContents Then
            ' Try unprotecting with old password
            On Error Resume Next
            ws.Unprotect Password:=sOldPassword
            
            If ws.ProtectContents Then
                ' Old password didn't work — might already be on new password
                ws.Unprotect Password:=sNewPassword
                If ws.ProtectContents Then
                    ' Neither password worked
                    LogAuditEvent "ERROR", sPath, ws.Name, "N/A", _
                                  "Cannot unprotect - password not recognized"
                    nSheetsFailed = nSheetsFailed + 1
                    GoTo NextSheet
                End If
            End If
            On Error GoTo ErrHandler
            
            ' Re-protect with new password, preserving existing settings
            ' We re-apply with conservative defaults; full settings are in policy
            ws.Protect Password:=sNewPassword, _
                        UserInterfaceOnly:=True, _
                        DrawingObjects:=True, _
                        Contents:=True, _
                        AllowSorting:=ws.Protection.AllowSorting, _
                        AllowFiltering:=ws.Protection.AllowFiltering, _
                        AllowFormattingCells:=ws.Protection.AllowFormattingCells, _
                        AllowInsertingRows:=ws.Protection.AllowInsertingRows, _
                        AllowDeletingRows:=ws.Protection.AllowDeletingRows
            
            LogAuditEvent "SUCCESS", sPath, ws.Name, "N/A", _
                          "Password rotated successfully"
        End If
NextSheet:
    Next ws
    
    ' Also rotate workbook structure protection if applicable
    If wbTarget.ProtectStructure Then
        On Error Resume Next
        wbTarget.Unprotect Password:=sOldPassword
        If wbTarget.ProtectStructure Then
            wbTarget.Unprotect Password:=sNewPassword
        End If
        On Error GoTo ErrHandler
        
        If Not wbTarget.ProtectStructure Then
            wbTarget.Protect Password:=sNewPassword, Structure:=True, Windows:=False
            LogAuditEvent "SUCCESS", sPath, "WORKBOOK", "N/A", _
                          "Workbook structure password rotated"
        End If
    End If
    
    wbTarget.Save
    If bOpenedByUs Then wbTarget.Close SaveChanges:=False
    
    RotatePasswordsInWorkbook = (nSheetsFailed = 0)
    Exit Function
    
ErrHandler:
    LogAuditEvent "ERROR", sPath, "N/A", "N/A", _
                  "Unexpected error during rotation: " & Err.Description
    If bOpenedByUs And Not wbTarget Is Nothing Then
        wbTarget.Close SaveChanges:=False
    End If
    RotatePasswordsInWorkbook = False
End Function

Private Sub UpdatePolicyPassword( _
    wsPolicy As Worksheet, _
    sWBPath As String, _
    sOldPassword As String, _
    sNewPassword As String _
)
    Dim lastRow As Long
    lastRow = wsPolicy.Cells(wsPolicy.Rows.Count, "A").End(xlUp).Row
    Dim i As Long
    
    For i = 2 To lastRow
        If Trim(wsPolicy.Cells(i, "A").Value) = sWBPath Then
            If Trim(wsPolicy.Cells(i, "G").Value) = sOldPassword Then
                wsPolicy.Cells(i, "G").Value = sNewPassword
            End If
        End If
    Next i
End Sub

---

The Audit Logging Subsystem

Every operation in our manager needs to be logged. Add a module named modAuditLog with the shared logging procedure that all other modules call.

Option Explicit

' ============================================================
' modAuditLog
' Centralized logging for all protection operations
' ============================================================

Public Sub LogAuditEvent( _
    sStatus As String, _
    sWorkbook As String, _
    sSheet As String, _
    sRange As String, _
    sMessage As String _
)
    Dim wsLog As Worksheet
    Dim nextRow As Long
    
    On Error GoTo ErrHandler
    
    Set wsLog = ThisWorkbook.Sheets("AuditLog")
    nextRow = wsLog.Cells(wsLog.Rows.Count, "A").End(xlUp).Row + 1
    
    ' Write headers if this is the first entry
    If nextRow = 2 And wsLog.Cells(1, 1).Value = "" Then
        With wsLog
            .Cells(1, 1).Value = "Timestamp"
            .Cells(1, 2).Value = "Status"
            .Cells(1, 3).Value = "Workbook"
            .Cells(1, 4).Value = "Sheet"
            .Cells(1, 5).Value = "Range"
            .Cells(1, 6).Value = "Message"
            .Range("A1:F1").Font.Bold = True
            .Range("A1:F1").Interior.Color = RGB(68, 114, 196)
            .Range("A1:F1").Font.Color = RGB(255, 255, 255)
        End With
    End If
    
    With wsLog
        .Cells(nextRow, 1).Value = Now()
        .Cells(nextRow, 1).NumberFormat = "yyyy-mm-dd hh:mm:ss"
        .Cells(nextRow, 2).Value = sStatus
        .Cells(nextRow, 3).Value = sWorkbook
        .Cells(nextRow, 4).Value = sSheet
        .Cells(nextRow, 5).Value = sRange
        .Cells(nextRow, 6).Value = sMessage
        
        ' Color-code by status
        Select Case UCase(sStatus)
            Case "SUCCESS"
                .Cells(nextRow, 2).Interior.Color = RGB(198, 239, 206)
                .Cells(nextRow, 2).Font.Color = RGB(0, 97, 0)
            Case "WARNING"
                .Cells(nextRow, 2).Interior.Color = RGB(255, 235, 156)
                .Cells(nextRow, 2).Font.Color = RGB(156, 101, 0)
            Case "ERROR"
                .Cells(nextRow, 2).Interior.Color = RGB(255, 199, 206)
                .Cells(nextRow, 2).Font.Color = RGB(156, 0, 6)
        End Select
    End With
    
    Exit Sub
ErrHandler:
    ' If logging itself fails, write to immediate window as fallback
    Debug.Print Now() & " | " & sStatus & " | " & sWorkbook & _
                " | " & sSheet & " | " & sRange & " | " & sMessage
End Sub

Public Function PrepareAuditSheet() As Worksheet
    Dim wsAudit As Worksheet
    
    On Error Resume Next
    Set wsAudit = ThisWorkbook.Sheets("AuditReport")
    On Error GoTo 0
    
    If wsAudit Is Nothing Then
        Set wsAudit = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsAudit.Name = "AuditReport"
    End If
    
    ' Set up headers
    With wsAudit
        .Cells(1, 1).Value = "Audit Time"
        .Cells(1, 2).Value = "Workbook"
        .Cells(1, 3).Value = "Sheet"
        .Cells(1, 4).Value = "Item Type"
        .Cells(1, 5).Value = "Range/Address"
        .Cells(1, 6).Value = "Protection State"
        .Cells(1, 7).Value = "Details"
        .Range("A1:G1").Font.Bold = True
        .Range("A1:G1").Interior.Color = RGB(68, 114, 196)
        .Range("A1:G1").Font.Color = RGB(255, 255, 255)
    End With
    
    Set PrepareAuditSheet = wsAudit
End Function

---

Deploying UserInterfaceOnly Protection on Workbook Open

Since UserInterfaceOnly doesn't persist across save/reopen cycles, we need a Workbook_Open event in every managed workbook to re-apply it. You can deploy this automatically. Add a procedure to modPolicyEngine that injects the event code:

Public Sub DeployOpenEventToWorkbook(sTargetPath As String, sPassword As String)
    ' Injects a Workbook_Open event that re-applies UserInterfaceOnly protection
    ' Requires a reference to Microsoft Visual Basic for Applications Extensibility
    
    Dim wbTarget As Workbook
    Dim bOpenedByUs As Boolean
    
    On Error Resume Next
    Set wbTarget = Workbooks(Dir(sTargetPath))
    On Error GoTo 0
    
    If wbTarget Is Nothing Then
        Set wbTarget = Workbooks.Open(sTargetPath, ReadOnly:=False, UpdateLinks:=False)
        bOpenedByUs = True
    End If
    
    Dim vbProj As Object ' VBIDE.VBProject
    Dim vbComp As Object ' VBIDE.VBComponent
    Dim codeModule As Object ' VBIDE.CodeModule
    
    Set vbProj = wbTarget.VBProject
    Set vbComp = vbProj.VBComponents("ThisWorkbook")
    Set codeModule = vbComp.codeModule
    
    ' Build the code to inject
    Dim sCode As String
    sCode = "Private Sub Workbook_Open()" & vbCrLf & _
            "    Dim ws As Worksheet" & vbCrLf & _
            "    For Each ws In Me.Worksheets" & vbCrLf & _
            "        If ws.ProtectContents Then" & vbCrLf & _
            "            ws.Protect Password:=""" & sPassword & """, " & _
                         "UserInterfaceOnly:=True, Contents:=True" & vbCrLf & _
            "        End If" & vbCrLf & _
            "    Next ws" & vbCrLf & _
            "End Sub"
    
    ' Remove existing Workbook_Open if present
    Dim lineCount As Long
    Dim startLine As Long
    lineCount = codeModule.CountOfLines
    
    On Error Resume Next
    startLine = codeModule.ProcStartLine("Workbook_Open", 0) ' 0 = vbext_pk_Proc
    On Error GoTo 0
    
    If startLine > 0 Then
        Dim procLines As Long
        procLines = codeModule.ProcCountLines("Workbook_Open", 0)
        codeModule.DeleteLines startLine, procLines
    End If
    
    ' Insert the new event handler
    codeModule.InsertLines codeModule.CountOfLines + 1, sCode
    
    wbTarget.Save
    If bOpenedByUs Then wbTarget.Close SaveChanges:=False
    
    LogAuditEvent "SUCCESS", sTargetPath, "ThisWorkbook", "N/A", _
                  "Workbook_Open event deployed for UserInterfaceOnly re-application"
End Sub

---

Building the Management UserForm

A command-line-style execution model (calling procedures from the Immediate window or via shortcut keys) works fine for technical users, but if you're handing this tool to a team lead or compliance officer, they need a proper interface. We'll build a compact management panel. If you're new to UserForms, Building UserForms for Custom Data Entry Interfaces covers the mechanics.

Insert a UserForm named frmProtectionManager. Add these controls:

• A Label at the top: "Workbook Protection Manager"
• A ListBox named lstWorkbooks (populates from ProtectionPolicy sheet)
• Four CommandButton controls:
  • btnApplyAll — caption "Apply All Policies"
  • btnAuditSelected — caption "Audit Selected Workbook"
  • btnRotatePassword — caption "Rotate Passwords"
  • btnClose — caption "Close"
• Two TextBox controls for password rotation: txtOldPassword and txtNewPassword
• Labels for those textboxes

' frmProtectionManager code module

Option Explicit

Private Sub UserForm_Initialize()
    Me.Caption = "Workbook Protection Manager"
    PopulateWorkbookList
End Sub

Private Sub PopulateWorkbookList()
    lstWorkbooks.Clear
    
    Dim wsPolicy As Worksheet
    Set wsPolicy = ThisWorkbook.Sheets("ProtectionPolicy")
    
    Dim lastRow As Long
    lastRow = wsPolicy.Cells(wsPolicy.Rows.Count, "A").End(xlUp).Row
    
    Dim dictPaths As Object
    Set dictPaths = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    For i = 2 To lastRow
        Dim sPath As String
        sPath = Trim(wsPolicy.Cells(i, "A").Value)
        If sPath <> "" And Not dictPaths.Exists(sPath) Then
            dictPaths.Add sPath, True
            lstWorkbooks.AddItem sPath
        End If
    Next i
    
    If lstWorkbooks.ListCount = 0 Then
        lstWorkbooks.AddItem "(No workbooks configured)"
    End If
End Sub

Private Sub btnApplyAll_Click()
    If MsgBox("Apply protection policies to ALL configured workbooks?" & vbCrLf & _
              "This will modify and save each workbook.", _
              vbQuestion + vbYesNo, "Confirm") = vbYes Then
        Call modPolicyEngine.ApplyAllPolicies
        MsgBox "Done. Review the AuditLog sheet for details.", vbInformation
    End If
End Sub

Private Sub btnAuditSelected_Click()
    If lstWorkbooks.ListIndex = -1 Then
        MsgBox "Please select a workbook from the list.", vbExclamation
        Exit Sub
    End If
    
    Dim sPath As String
    sPath = lstWorkbooks.Value
    
    If sPath = "(No workbooks configured)" Then Exit Sub
    
    Call modAuditEngine.AuditWorkbook(sPath)
End Sub

Private Sub btnRotatePassword_Click()
    If txtOldPassword.Text = "" Or txtNewPassword.Text = "" Then
        MsgBox "Enter both old and new passwords before rotating.", vbExclamation
        Exit Sub
    End If
    
    If txtOldPassword.Text = txtNewPassword.Text Then
        MsgBox "Old and new passwords are identical. No rotation needed.", vbInformation
        Exit Sub
    End If
    
    Dim sScope As String
    If lstWorkbooks.ListIndex = -1 Then
        sScope = "" ' All workbooks
    Else
        sScope = lstWorkbooks.Value
    End If
    
    If MsgBox("Rotate password from [" & String(Len(txtOldPassword.Text), "*") & "]" & _
              " to [" & String(Len(txtNewPassword.Text), "*") & "]?" & vbCrLf & _
              IIf(sScope = "", "Scope: ALL managed workbooks", "Scope: " & sScope), _
              vbQuestion + vbYesNo, "Confirm Password Rotation") = vbYes Then
        
        Call modPasswordRotation.RotateSheetPasswords( _
            txtOldPassword.Text, txtNewPassword.Text, sScope)
        
        txtOldPassword.Text = ""
        txtNewPassword.Text = ""
    End If
End Sub

Private Sub btnClose_Click()
    Unload Me
End Sub

---

Hands-On Exercise

Now you'll assemble and test the complete system. Follow these steps:

Setup (15 minutes)

1. Create a new workbook named ProtectionManager.xlsm. This is your management hub.
2. Create two sheets: ProtectionPolicy and AuditLog. Add the column headers described in the architecture section.
3. Create a second test workbook named RegionalSales_Q3.xlsx with three sheets: InputData, Formulas, and Summary.
4. On InputData, put sample data in columns A through E, rows 1 through 20. Column A is "Region", B is "Rep Name", C is "Q3 Sales", D is "Target", E is a formula =C2/D2 repeated down.

Configuration (10 minutes)

5. In ProtectionPolicy, add these rows:

WorkbookPath	SheetName	RangeAddress	LockState	AllowEditTitle	AllowEditPW	SheetPW	AllowSelectLocked	AllowSort	AllowFilter
[full path]\RegionalSales_Q3.xlsx	InputData	A1:D1	LOCKED			Finance2024!	TRUE	TRUE	TRUE
[full path]\RegionalSales_Q3.xlsx	InputData	A2:D20	UNLOCKED			Finance2024!	TRUE	TRUE	TRUE
[full path]\RegionalSales_Q3.xlsx	InputData	E1:E20	LOCKED			Finance2024!	TRUE	FALSE	FALSE
[full path]\RegionalSales_Q3.xlsx	Formulas	A1:Z100	LOCKED			Finance2024!	FALSE	FALSE	FALSE

6. Insert all the code modules from this lesson into ProtectionManager.xlsm.

Testing (20 minutes)

7. Run ApplyAllPolicies. Check that RegionalSales_Q3.xlsx was saved with the correct protection state.
8. Open RegionalSales_Q3.xlsx and verify: column A through D in the input range are editable, column E is locked, and the Formulas sheet is fully locked.
9. Run AuditWorkbook passing the full path to RegionalSales_Q3.xlsx. Review the AuditReport sheet.
10. Test password rotation: run RotateSheetPasswords with "Finance2024!" as old and "Finance2025!" as new. Verify the policy sheet was updated and the workbook can still be unprotected.

---

Common Mistakes & Troubleshooting

"The sheet is protected" error when modifying cells in VBA

The most common mistake. You've applied UserInterfaceOnly:=True but then closed and reopened the workbook, which cleared the UI-only flag. Your VBA code is now blocked by full protection. Fix: implement the Workbook_Open event in the target workbook to re-apply UserInterfaceOnly:=True on every open. This is the single most important deployment step people skip.

AllowEditRanges disappear after Protect is called again

AllowEditRanges must be registered before the Protect call, or they're wiped when you protect the sheet. In our engine, we add them while the sheet is unprotected, then call Protect at the end. If you call Protect first and then try to add AllowEditRanges, they'll be cleared the next time you call Protect.

Password rotation leaves some sheets still on old password

This happens when the policy sheet has inconsistent passwords across rows for the same workbook. The rotation engine tries both old and new passwords, but if a sheet was manually protected with a third, completely different password, neither will work. The audit log will flag these. Solution: run AuditWorkbook first to get a baseline, then fix inconsistencies before rotating.

Workbooks(Dir(sPath)) returns Nothing even though the file is open

Dir(sPath) returns just the filename (e.g., RegionalSales_Q3.xlsx), and Workbooks() is indexed by the filename as Excel knows it. If the workbook was opened as read-only or from a different path instance, the collection lookup can fail. Use a loop through Workbooks comparing .FullName properties for a more reliable match:

Private Function GetOpenWorkbook(sFullPath As String) As Workbook
    Dim wb As Workbook
    For Each wb In Workbooks
        If LCase(wb.FullName) = LCase(sFullPath) Then
            Set GetOpenWorkbook = wb
            Exit Function
        End If
    Next wb
    Set GetOpenWorkbook = Nothing
End Function

Protection settings not saved when UserInterfaceOnly:=True is used

This is by design — it's what makes UserInterfaceOnly work. But it means if you call ws.Protect with UserInterfaceOnly:=True and then save, the protection is saved, but the UserInterfaceOnly flag is not. The next session treats the sheet as fully protected. This is not a bug; it's the documented behavior. Design around it.

The VBA project injection fails with "Programmatic access to Visual Basic Project is not trusted"

This is a Trust Center restriction. You cannot bypass it with code — it must be enabled by the user or by Group Policy. For corporate environments where you can't change this, package your Workbook_Open code in a template (.xltm) and provision new managed workbooks from that template. The lesson on Building a Custom VBA Event-Driven Framework: Respond to Workbook, Worksheet, and Application Events for Real-Time Automation covers event-driven architecture patterns that can help you design around this constraint.

---

Summary & Next Steps

You've built a complete, enterprise-grade workbook protection management system. Let's recap what the system does and why each piece matters:

The protection architecture — understanding that cell locking, sheet protection, and workbook structure protection are three independent layers that must be applied in the right order is the foundation everything else rests on. Most protection bugs come from violating this order.

The policy engine — by driving all protection decisions from a configuration sheet rather than hardcoded procedures, you've created a system that can manage dozens of workbooks without code changes. Adding a new workbook to governance is as simple as adding rows to ProtectionPolicy.

AllowEditRanges — this is the feature that enables true role-based access within a protected sheet. Instead of choosing between "fully open" and "fully locked," you can define exactly which ranges each team or role can edit.

The audit engine — protection without audit is blind faith. The audit engine gives you a point-in-time snapshot of the actual protection state, which is essential for compliance reviews and for debugging discrepancies between policy and reality.

Password rotation — the batch rotation capability transforms a multi-hour manual task into a two-minute automated operation with a full audit trail.

Where to go next: Consider extending this system to generate a protection compliance report using techniques from Building an Automated Reporting System with VBA — automatically emailing the audit output to a compliance team on a schedule. You might also explore using VBA Arrays and Collections for Efficient Data Processing to dramatically speed up the cell audit function by reading all Locked properties into an array rather than iterating cell by cell.

For organizations managing truly large fleets of workbooks, the next architectural step is converting this manager into an add-in — distributing it organization-wide without requiring each user to have a copy of the manager workbook. Building Excel Add-Ins with VBA: Package and Deploy Custom Tools Across Your Organization shows you exactly how to make that transition.