Here is an idea to try. For this to work, you have to assign a Conditional
Format formula to each cell you want to subtly protect, but there is no need
to actually give the cells a format (the formula is all we need). Since this
is a Conditional Format, you can select all the cells you want to be in the
subtly protected group and give them all the Conditional Format formula all
at once. Later on, you can add a new cell or cells to the subtly protected
group by simply giving the cell or cells the same Conditional Format formula
(no need to touch the other already conditionally formatted cells). Also, to
remove a cell or cells from the subtly protected group, just clear that cell
or those cells' conditional format. Okay, the formula I am suggesting is
this...
="PROTECTED"
(although any constant value will do) and I am suggesting you always assign
it by selecting "Formula Is" in the Conditional Format dialog box (there
seemed to be some instances when using "Cell Value Is" and "equal to" when
it didn't work right). The code shown below is set it automatically "do its
thing" when the workbook is first opened; however, if you add or remove any
cells from the subtly protected grouping, then you **must** run the
InitializeSubtleProtect macro in order to update everything. By the way, if
you need to change any values in the subtly protected group of cells, just
remove its Conditional Format, make your change to the cell value, reapply
the Conditional Format and run the InitializeSubtleProtect macro. Okay, with
the usage instructions out of the way, here is the code and with they should
be located...
Add a Module to the project and copy/paste this into the Module's code
window...
'*************** BEGIN MODULE CODE ***************
Public ProtectedCells As New Collection
Public Const AlwaysProtectedCell As String = "A5"
Public Sub InitializeSubtleProtect()
Dim X As Long
Dim C As Range
For X = 1 To ProtectedCells.Count
ProtectedCells.Remove 1
Next
For Each C In Range(AlwaysProtectedCell).SpecialCells( _
xlCellTypeSameFormatConditions)
ProtectedCells.Add C.Value, C.Address
Next
End Sub
'*************** END MODULE CODE ***************
Copy/Paste this into the ThisWorkbook code window...
'*************** BEGIN ThisWorkbook CODE ***************
Private Sub Workbook_Open()
InitializeSubtleProtect
End Sub
'*************** END ThisWorkbook CODE ***************
Finally, copy/paste this code into **every** worksheet code window (I used
Sheet1 for example purposes) where you want to have subtly protected
cells...
'*************** BEGIN Sheet1 CODE ***************
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range
If Range(AlwaysProtectedCell).FormatConditions.Count = 0 Then
Range(AlwaysProtectedCell).FormatConditions.Add _
xlExpression, , "=""PROTECTED"""
End If
For Each C In Target
If Not Intersect(C, Range(AlwaysProtectedCell).SpecialCells( _
xlCellTypeSameFormatConditions)) Is Nothing Then
On Error GoTo Whoops
Application.EnableEvents = False
C.Value = ProtectedCells(C.Address)
End If
Next
Whoops:
Application.EnableEvents = True
End Sub
'*************** BEGIN Sheet1 CODE ***************
That's it. Save the workbook; then either close and reopen or run the
InitializeSubtleProtect macro to set everything up. After that, all cells
with a Conditional Format formula of ="PROTECTED" will not be able to be
permanently changed by either typing into, pasting over or series filling
across.
Let me know if this works out for you or not.
--
Rick (MVP - Excel)
Lance Roberts said:
Howdy Joshua,
That's what I'm looking at as my last resort (though using the
Change Event), but since there are a lot of entries (and selections)
on the page, it would be a lot of extra processing.
