Locking all cells of a given color in a given range

[Michael Siegel]

Hi.

I'm trying to write a macro to look at all cells in a named range
("input_range") and 1) lock them if interior.colorindex = xlnone or 2)
unlock them if interior.colorindex = 36.

This routine should be called when a given cell's picklist value is
changed. The cell with the picklist is actually two merged cells, and
I've created a named range called "input_begin" for the picklist.

Can somebody please recommend an approach? Thanks!

-Michael

 

[Coza]

How about something like:


Dim input_range as Range
With input_range
if .Cells.Interior.ColorIndex=36 then
..Cells.locked = false
else
..Cells.Locked = True
end if
end with



Corey....

 

[Michael Siegel]

Thanks Corey.

This works, assuming none of the cells in "Input_Range" are merged.
Unfortunately, some of them ARE merged. Assuming I cannot unmerge these
cells without losing integral functionality, how can I modify your code
to accomodate merged cellse?

Thanks!
Michael

 

[Peter T]

Sub test()
Dim input_range As Range
Dim cel As Range

' for testing merge A2:B2
Set input_range = Range("A1:A2")

For Each cel In input_range
With cel
If .Interior.ColorIndex < 1 Or .Interior.ColorIndex = 2 Then
..MergeArea.Locked = True
ElseIf .Interior.ColorIndex = 36 Then
..MergeArea.Locked = False
End If
End With
Next

End Sub

Regards,
Peter T

 

[Michael Siegel]

Corey,

Thank you. I tested your code, and it seems to only work for the merged
cells, but not for the unmerged cells. I have some of each in the range
to be tested. How can I modify the code to look for BOTH types of cells
in this range?

Thanks.
Michael

 

[Coza]

Try:

Sub test()
Dim input_range As Range
Dim cel As Range

' for testing merge A2:B2
Set input_range = Range("A1:A2")

For Each cel In input_range
With cel
If .Interior.ColorIndex < 1 Or .Interior.ColorIndex = 2 Then
..MergeArea.Locked = True
..cel.Locked = True
ElseIf .Interior.ColorIndex = 36 Then
..MergeArea.Locked = False
..cel.Locked = False
End If
End With
Next

End Sub


Corey....

 

[Michael Siegel]

It's working now. THANKS!!!