Protect Cells worksheet except Yellow Cells - VBA

raj08536

Active Member
Joined
Aug 16, 2007
Messages
252
I am working on creating a template for our Sales people. They are only allowed to enter in yellow highlighted cells. I want to protect all worksheets.

Following the code giving me error 1004 at Range.locked = True

Please help


Sub Lock_Color()
Dim colorIndex As Integer
Dim i 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 = False
Else
Range.Locked = True
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
 
Last edited:

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
You are on the right track, one essential line is missing ...

Rich (BB code):
Sub Lock_Color()
Dim colorIndex As Integer
Dim i 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 = False
Else
Range.Locked = True
End If
Next Range
'Protect worksheet
Sheets(i).EnableSelection = xlUnlockedCells
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
 

raj08536

Active Member
Joined
Aug 16, 2007
Messages
252
You are on the right track, one essential line is missing ...

Rich (BB code):
Sub Lock_Color()
Dim colorIndex As Integer
Dim i 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 = False
Else
Range.Locked = True
End If
Next Range
'Protect worksheet
Sheets(i).EnableSelection = xlUnlockedCells
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
Thanks

I tried again but I realized it does'nt go beyond Range.Locked = True
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
I see, that might happen since Range is a VBA keyword and for that not to be used as a variable name. Replace it with a proper name, such as

VBA Code:
Dim MyRange as Range
 

raj08536

Active Member
Joined
Aug 16, 2007
Messages
252

ADVERTISEMENT

I see, that might happen since Range is a VBA keyword and for that not to be used as a variable name. Replace it with a proper name, such as

VBA Code:
Dim MyRange as Range
Following is my revised code

Sub Lock_Color()
Dim colorIndex As Integer
Dim i As Integer
Dim MyRange As Range
'Lock all the cells that are selected color

colorIndex = 6 '6 = yellow

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

Dim color As Long
color = MyRange.Interior.colorIndex
If (color = colorIndex) Then
MyRange.Locked = False
Else
MyRange.Locked = True
End If
Next MyRange
'Protect worksheet
Sheets(i).EnableSelection = xlUnlockedCells
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


but i am still getting the error at MyRange.Locked = True

Please help
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
First of all you have to be sure the worksheet involved is NOT protected. You could include such a line at the beginning of the code loop in question:
VBA Code:
Sheets(i).Unprotect Password:="123456"
 

raj08536

Active Member
Joined
Aug 16, 2007
Messages
252

ADVERTISEMENT

First of all you have to be sure the worksheet involved is NOT protected. You could include such a line at the beginning of the code loop in question:
VBA Code:
Sheets(i).Unprotect Password:="123456"
Looks like I can't lock merged cells. I need merged cells so I can run this code. Can you suggest any thing else?
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
Looks like I can't lock merged cells. I need merged cells so I can run this code. Can you suggest any thing else?
Regarding merged cells I would say: get rid of them, there's no need for them and they give you issues, one way or the other.
When it comes to formatting your worksheet, you can spread text across multiple cells: Format Cells > Alignment tab > Center Across Selection ...

ScreenShot035.png

ScreenShot036.png
 

Watch MrExcel Video

Forum statistics

Threads
1,129,268
Messages
5,635,180
Members
416,846
Latest member
ImGoing2needaFormula

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top