Fast method for determining unlocked cell range

Using SpecialCells to quickly identify unlocked cells

The code below - QuickUnlocked - uses a workaround to quickly generate a SpecialCells collection of error cells to identify the unlocked cell range.

The key code steps are:

• Alter the Application to suppress errors, code and screenupdating
• Attempt to unlock the ActiveWorkbook and/or the ActiveSheet if they are protected. Exit the code if unsuccessful
• Make a replica of the current sheet
• Delete any existing formula errors in the replica using SpecialCells
• Protect the replica worksheet and with the coverage of error handling, add a deliberate formula error that will only populate the unlocked cells
• Clean up and report the results Reset the Application settings

Warning that SpecialCells is restricted to 8192 Areas prior to Xl2010

As per this Microsoft KB article, Excel-2007 and earlier versions supports up to a maximum of 8,192 non-contiguous cells through VBA macros. Rather surprisingly, applying a VBA macro to more than 8192 SpecialCells Areas in these Excel versions, will not raise an error message, and the entire area under consideration will be treated as being part of theSpecialCells` range collection.

Quick Unlocked code

Sub QuickUnlocked()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim lCalc As Long
    Dim bWorkbookProtected As Boolean

    On Error Resume Next
    'test to see if WorkBook structure is protected
    'if so try to unlock it
    If ActiveWorkbook.ProtectStructure Then
        ActiveWorkbook.Unprotect
        If ActiveWorkbook.ProtectStructure Then
            MsgBox "Sorry, I could not remove the passsword protection from the workbook" _
                 & vbNewLine & "Please remove it before running the code again", vbCritical
            Exit Sub
        Else
            bWorkbookProtected = True
        End If
    End If

    Set ws1 = ActiveSheet
    'test to see if current sheet is protected
    'if so try to unlock it
    If ws1.ProtectContents Then
        ws1.Unprotect
        If ws1.ProtectContents Then
            MsgBox "Sorry, I could not remove the passsword protection from sheet" & vbNewLine & ws1.Name _
                 & vbNewLine & "Please remove it before running the code again", vbCritical
            Exit Sub
        End If
    End If
    On Error GoTo 0

    'disable screenupdating, event code and warning messages.
    'set calculation to manual
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        lCalc = .Calculation
        .Calculation = xlCalculationManual
    End With

    On Error Resume Next
    'check for existing error cells
    Set rng1 = ws1.Cells.SpecialCells(xlCellTypeFormulas, 16)
    On Error GoTo 0

    'copy the activesheet to a new working sheet
    ws1.Copy After:=Sheets(Sheets.Count)
    Set ws2 = ActiveSheet
    'delete any cells that already contain errors
    If Not rng1 Is Nothing Then ws2.Range(rng1.Address).ClearContents

    'protect the new sheet
    ws2.Protect
    'add an error formula to all unlocked cells in the used range
    'then use SpecialCells to read the unlocked range address
    On Error Resume Next
    ws2.UsedRange.Formula = "=NA()"
    ws2.Unprotect
    Set rng2 = ws2.Cells.SpecialCells(xlCellTypeFormulas, 16)
    Set rng3 = ws1.Range(rng2.Address)
    ws2.Delete
    On Error GoTo 0

    'if WorkBook level protection was removed then reinstall it
    If bWorkbookProtected Then ActiveWorkbook.Protect

    'cleanup user interface and settings
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        lCalc = .Calculation
    End With

    'inform the user of the unlocked cell range
    If Not rng3 Is Nothing Then
        MsgBox "The unlocked cell range in Sheet " & vbNewLine & ws1.Name & " is " & vbNewLine & rng3.Address(0, 0)
    Else
        MsgBox "No unlocked cells exist in " & ws1.Name
    End If

End Sub

Use Conditional Formatting with:- Use a formula to determine which cells to format, Format values where this formula is true: =CELL("protect",A1)=0 and Format of choice applied to occupied range?

Well, I've gone back to a loop, but I think this method is efficient because it only references those cells which are Unlocked (without selecting) using Next:

If the object is a range, this property emulates the TAB key, although the property returns the next cell without selecting it.

On a protected sheet, this property returns the next unlocked cell. On an unprotected sheet, this property always returns the cell immediately to the right of the specified cell.

It stores the first (Next) Range.Address, loops through the others until it returns to this first one.

Sub GetUnlockedCells_Next()
    Dim ws As Worksheet
    Dim strFirst As String
    Dim rngNext As Range
    Dim strLocked As String

    Set ws = Worksheets(1)
    ws.Protect
    Set rngNext = ws.Range("A1").Next
    strFirst = rngNext.Address
    Do
        strLocked = strLocked & rngNext.Address & ","
        Set rngNext = rngNext.Next
    Loop Until rngNext.Address = strFirst
    strLocked = Left(strLocked, Len(strLocked) - 1)     'remove the spare comma
    ws.Range(strLocked).Select
    ws.Unprotect
    MsgBox strLocked
End Sub