Color Unlocked Cells
My customer had a number of workbooks, each having up to 20 worksheets in each one.
He was trying to unlock some cells and lock down the headings and formula cells.
The good thing about this macro is that it can be run multiple times against the same sheets so if you are constantly changing and checking your work, you get immediate gratification.
Option Explicit
Public IteM As Variant, SheetR As Integer, DdD As Integer, SheetC as Integer
Sub ColorActive()
SheetR = 0 'Reset counter
SheetC = ActiveWorkbook.Worksheets.Count 'See how many sheets to work on
For DdD = 1 To SheetC 'Work from Sheet 1 to ...
Worksheets(DdD).Activate 'Activate active sheet
ActiveSheet.Unprotect 'Unprotect - assuming no password
For Each IteM In ActiveSheet.UsedRange 'Color cells according to locked
If IteM.Locked = False Then 'If not locked
IteM.Font.ColorIndex = 32 'Blue for unlocked
SheetR = SheetR + 1 'Add to cells fixed count
ElseIf IteM.Locked = True Then 'If IS locked ...
IteM.Font.ColorIndex = xlAutomatic 'Set color to default
End If
Next 'Loop next cell
ActiveSheet.Protect 'Re-protect
Next
MsgBox SheetR & " cells were colored Blue if 'unlocked'", 64 'Done message
End Sub
|