<

A fast method for determining the unlocked cell range

Published on
10,264 Points
2,764 Views
5 Endorsements
Last Modified:
Approved
Community Pick

Introduction

The SpecialCells Method provides VBA developers with readymade collections of cells with certain properties. This technique is commonly used to optimise code when working with these specific cell collections within an area of interest, for example quickly filling in the blanks cells within the used portion of column A.

The MSDN library article on SpecialCells is found here. The following screenshot was sourced from this link.

With a bit of tweaking the SpecialCells approach offers a shortcut technique to identifying other cell collections that do not have inbuilt SpecialCells functionality.
 

Indentifying the unlocked cells in the ActiveSheet

A common request in the online forums is for code to indentify the unlocked cells. A typical, and normally suitable solution, is to use a loop to iterate through each cell in the used portion of the active worksheet. A code sample for this approach is listed below.

Sub TypicalUnlocked()

    Dim rng1 As Range
    Dim rng2 As Range

    For Each rng1 In ActiveSheet.UsedRange
        If Not rng1.Locked Then
            If rng2 Is Nothing Then
                Set rng2 = rng1
            Else
                Set rng2 = Union(rng2, rng1)
            End If
        End If
    Next rng1

    If rng2 Is Nothing Then
        MsgBox "No unlocked cells in " & ActiveSheet.Name
    Else
        MsgBox "Unlocked range is " & rng2.Address(0, 0)
    End If

End Sub

Open in new window

As per my comments in  Using Variant Arrays in Excel VBA for Large Scale Data Manipulation,  For … Next loops though ranges can often produce significant bottlenecks for developers. In this particular case, SpecialCells offers a quick alternative for indentifying the unlocked cell range.
 

Using SpecialCells to optimise code timing

The code below - QuickUnlocked - uses a workaround to quickly generate a SpecialCells collection of error cells to indentify the unlocked cell range.
 
The key code steps are:
Change 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

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

    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

Open in new window

 

Other Notes

Note that Excel supports a maximum of 8,192 non-contiguous cells through VBA macros. If the SpecialCells approach is applied to a selection that contains more than 8192 areas then the actions that were only supposed to occur with the non-contiguous cells occur to every cell in the selection. For more information see  The .SpecialCells(xlCellTypeBlanks) VBA function does not work as expected in Excel,

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
If you liked this article and want to see more from this author, please click here.

If you found this article helpful, please click the Yes button near the:

      Was this article helpful?

label that is just below and to the right of this text.   Thanks!
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
5
Comment
Author:Dave
0 Comments

Featured Post

Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

Join & Write a Comment

This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month