Protect Workbook cells by color

[raj08536]

I have found following code to cell protect by color. It only work for activesheet. Can we expand for active workbook?

Sub Lock_Color()
Dim colorIndex As Integer

Dim Range As Range
'Lock all the cells that are selected color

colorIndex = 6 '6 = yellow
For Each Range In ActiveSheet.UsedRange.Cells
Dim color As Long
color = Range.Interior.colorIndex
If (color = colorIndex) Then
Range.Locked = True
Else
Range.Locked = False
End If
Next Range
'Protect worksheet
ActiveSheet.Protect Password:="123456", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
MsgBox "Highlighted cells are locked!"
End Sub

 

[Coding4Fun]

This code seems to actually be Protecting the entire sheet vs just those specific cells which are yellow, it locks the specific cells but locks the entire sheet. Just in case someone else reading this decides to use this code.

Here is the revised version that would run all sheets vs just the active sheet.

Sub Lock_Color()
Dim colorIndex As Integer

Dim Range As Range
'Lock all the cells that are selected color

colorIndex = 6 '6 = yellow

For i = 1 To ActiveWorkbook.Worksheets.Count
For Each Range In Sheets(i).UsedRange.Cells

Dim color As Long
color = Range.Interior.colorIndex
If (color = colorIndex) Then
Range.Locked = True
Else
Range.Locked = False
End If
Next Range
'Protect worksheet
Sheets(i).Protect Password:="123456", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
MsgBox "Highlighted cells are locked!"
Next i
End Sub