Unlock certain cells based on ColorIndex
Peter,
This seems to be working okay. Thanks so much!
"Peter T" wrote:
Have a go with this -
Sub UnLockClrIdx36()
Dim sPassWord As String
Dim rng As Range, cell As Range
Dim wb As Workbook
Dim ws As Worksheet
sPassWord = "" ' "abc"
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
With ws
.Unprotect sPassWord
Set rng = .Range(.Cells(1, 1), .Cells(320, 40))
Set rng = Intersect(.UsedRange, rng)
End With
For Each cell In rng
If cell.Interior.ColorIndex = 36 Then
With cell
.Locked = False
.FormulaHidden = False
End With
End If
Next
ws.Protect _
Password:=sPassWord, _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
Next
End Sub
Regards,
Peter T
"Samantha" wrote in message
...
I am working on a document that calculates indices based on a set of
default
weightings. I want to allow the user to redistribute these weights without
changing the default information. It is set up so that the user can make
alterations in the cells that have a yellow background. There are many
sheets
in the workbook and the location of the yellow cells are not uniform. I've
written the following code that loops through each worksheet, unlocks the
yellow cells, and protects the sheet. The trouble is that it is very buggy
and for some reason selects some yellow cells but not others. Occasionally
I
get an error 1004 message. Is there a more elegant way to do this?
For Each wks In ActiveWorkbook.Worksheets
str = wks.Name
'Unlock yellow cells
For ColIndex = 1 To 40
For RowIndex = 1 To 320
If Cells(RowIndex, ColIndex).Interior.ColorIndex = 36 Then
Cells(RowIndex, ColIndex).Locked = False
Cells(RowIndex, ColIndex).FormulaHidden = False
End If
Next RowIndex
Next ColIndex
'Protect worksheet
wks.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next wks
|