Sub UnlockCell()
If ActiveSheet Is Nothing Then Exit Sub
Dim Count, rng, Unlocked, Msg, Response
If Selection.Cells.Count = 1 Then
MsgBox "You must select a range before running this utility." & Chr(13) & "Please select a range and run the routine again.", , "Ultimate Add-In : Find Unlocked Cells"
Exit Sub
End If
Count = 0
On Error Resume Next
For Each rng In Selection
If rng.Locked = False Then
Count = Count + 1
If Count = 1 Then Set Unlocked = rng
If Count <> 1 Then Set Unlocked = Union(Unlocked, rng)
End If
Next rng
Msg = "cells"
If Count = 1 Then Msg = "cell"
If Count = 0 Then
MsgBox "There are no unlocked cells in the range " & Selection.Address, , "Ultimate Add-In : Find Unlocked Cells"
Exit Sub
End If
Response = MsgBox("Excel has counted " & Count & " unlocked " & Msg & " in the range " & Selection.Address & "." & Chr(13) & Chr(13) & "Would you like Excel to auto select the unlocked " & Msg & "?", vbYesNo, "Ultimate Add-In : Find Unlocked Cells")
If Response = vbYes Then
Unlocked.Select
End If
End Sub