Lock Cells Based On Interior Colour Including Conditional Fomatting

I have the following code in a Worksheet_Change() event that locks cells based on their interior colour.

Code:

---

Dim cell
For Each cell In ActiveSheet.Range("A1:Y160")
  If cell.MergeCells = False Then
    Select Case True
      Case cell.Interior.ColorIndex = 15
          cell.Locked = True
      Case Else
          cell.Locked = False
    End Select
  Else
    Set mergedRange = cell.MergeArea
    Select Case True
      Case mergedRange.Interior.ColorIndex = 15
          mergedRange.Locked = True
      Case Else
          mergedRange.Locked = False
    End Select
  End If
Next

---

This code works perfectly, locking all cells and mergeareas with a 25% grey background.

However, some cells/mergeareas contain conditional formatting to change the colour of the background. This conditional formatting is formula-based, as the formatting is based on the contents of other cell(s).

For example: mergearea(F6:O6)'s formatting is dependent on the value of cell(L4), while cell(Q126)'s formatting is based on the values of cells(Q138, F126 and B126).

This means that certain cells/mergeareas that should not be locked are being locked (due to having a default 25% grey background), while others that should be locked are not being locked (due to not having a default 25% grey brackgroud).

I've seen the code on Rick's thread (http://www.excelfox.com/forum/f22/ge...ng-or-not-338/), but I am not sure how to incorporate it into the above (or if there is another way of doing what I want). I am also aware of the DisplayFormat property, but unfortunately this is not an option as I need backward-compatability with Excel 2007 (some users are running 2007, while others are using 2010 - I am coding in 2007).

I may be able to upload the form that this code is being used in, but am currently seeking confirmation from my employer that I am permitted to do so.

Hi

Welcome to ExcelFox!!

Try this untested code. You have to define the color depending upon the other cells.

Code:

---

Dim Cell As Range
Dim mergedRange As Range

For Each Cell In ActiveSheet.Range("A1:Y160")
  If Cell.MergeCells = False Then
    Select Case True
      Case Cell.Interior.ColorIndex = 15
          Cell.Locked = True
      Case Else
          Cell.Locked = False
    End Select
  Else
    Set mergedRange = Cell.MergeArea
   
    Select Case mergedRange.Address(0, 0)
        Case "F6:O6"
            If Range("L4").Value = "Whatever" Then
                mergedRange.Interior.ColorIndex = 15    'adjust the color index
                mergedRange.Locked = True
            Else
                mergedRange.Interior.ColorIndex = 15    'adjust the color index
                mergedRange.Locked = True
            End If
        Case "Q126"
            'same as above
       
        Case Else
            Select Case True
              Case mergedRange.Interior.ColorIndex = 15
                  mergedRange.Locked = True
              Case Else
                  mergedRange.Locked = False
            End Select
  End If
Next

---

Thanks for the reply (and welcome!).

If possible, I would prefer to avoid doing single-cell/mergearea specifications in the code. The form is quite complex, with a not-insignificant number of questions, and a significant number of those have impacts on other questions within the form. I already have too many absolute-references in some of the other code, which makes updating in when additional questions are inserted a real chore. (I realise that seeing the form would probably help explain all this, but I am still waiting on an answer from my employer).

If there is no other way, I will look at switching all of the conditional formatting into the code, but I was really hoping that wouldn't be necessary...

Hi

Create a mockup by putting some dummy values. Be careful that the format of the sheet is same in the mockup version as well.

I have attached a stripped-down version of one page of the form.

Attachment 1306

All of the code for the Command Button Click() events have been stripped out, since they won't work anyway without the rest of the workbook (not to mention being irrelevant to what I am asking about), and I have removed passwords, etc.

Hopefully this helps show what it is I need/want to accomplish.

Hi

Can you please try this one ?

Code:

---

Dim Cell    As Range
Dim mergedRange As Range

Range("A1:Y160").Locked = False
For Each Cell In ActiveSheet.Range("A1:Y160")
  If Cell.MergeCells = False Then
    If Cell.FormatConditions.Count = 0 Then
        If Cell.Interior.ColorIndex = 15 Then Cell.Locked = True
    Else
        If Cell.DisplayFormat.Interior.ColorIndex = 15 Then
            If Cell.Borders.ColorIndex = xlNone Then
                Cell.Locked = True
            End If
        End If
    End If
  Else
    Set mergedRange = Cell.MergeArea
    If mergedRange.FormatConditions.Count = 0 Then
        If mergedRange.Interior.ColorIndex = 15 Then mergedRange.Locked = True
    Else
        'If Cell.Address = "$O$20" Then Stop
        If mergedRange.DisplayFormat.Interior.ColorIndex = 15 Then
            If mergedRange.Borders(xlEdgeTop).ColorIndex = xlNone Then
                mergedRange.Locked = True
            End If
        End If
    End If
  End If
Next

---

Unfortunately that code does not work due to the DisplayFormat property, which is not present in Excel 2007 (this line of the code:)

Code:

---

If mergedRange.DisplayFormat.Interior.ColorIndex = 15 Then

---

As stated in my original post, I need to ensure compatability with 2007 due to not all users having 2010 installed (me being one of them).

Hi

OK. Try this.

Code:

---

Dim Cell    As Range
Dim mergedRange As Range
Dim xlVer  As Long
Dim dColor  As Long

xlVer = Val(Application.Version)

Range("A1:Y160").Locked = False
For Each Cell In ActiveSheet.Range("A1:Y160")
  If Cell.MergeCells = False Then
    If Cell.FormatConditions.Count = 0 Then
        If Cell.Interior.ColorIndex = 15 Then Cell.Locked = True
    Else
        If xlVer > 12 Then
            If Cell.DisplayFormat.Interior.ColorIndex = 15 Then
                If Cell.Borders.ColorIndex = xlNone Then
                    Cell.Locked = True
                End If
            End If
        Else
            dColor = DisplayedColor(Cell, True)
            If dColor = 15 Then
                'If Cell.Borders.ColorIndex = xlNone Then
                    Cell.Locked = True
                'End If
            End If
        End If
    End If
  Else
    Set mergedRange = Cell.MergeArea
    If mergedRange.FormatConditions.Count = 0 Then
        If mergedRange.Interior.ColorIndex = 15 Then mergedRange.Locked = True
    Else
        'If Cell.Address = "$O$20" Then Stop
        If xlVer > 12 Then
            If mergedRange.DisplayFormat.Interior.ColorIndex = 15 Then
                If mergedRange.Borders(xlEdgeTop).ColorIndex = xlNone Then
                    mergedRange.Locked = True
                End If
            End If
        Else
            dColor = DisplayedColor(mergedRange.Cells(1), True)
            If dColor = 15 Then
                If mergedRange.Borders(xlEdgeTop).ColorIndex = xlNone Then
                    mergedRange.Locked = True
                End If
            End If
        End If
    End If
  End If
Next

---

in a standard module, use Rick's Function

Code:

---

Option Explicit


' Arguments
' ----------------
' Cell - Required Range, not a String value, for a **single** cell
'
' CellInterior - Optional Boolean (Default = True)
'                True makes function return cell's Interior Color or ColorIndex based on
'                the ReturnColorIndex argument False makes function return Font's Color or
'                ColorIndex based on the ReturnColorIndex argument
'
' ReturnColorIndex - Optional Boolean (Default = True)
'                    True makes function return the ColorIndex for the cell property determined
'                    by the CellInterior argument False make function return the Color for the
'                    cell property determined by the CellInterior argument
'
Function DisplayedColor(Cell As Range, Optional CellInterior As Boolean = True, _
                        Optional ReturnColorIndex As Long = True) As Long
  Dim X As Long, Test As Boolean, CurrentCell As String
  If Cell.Count > 1 Then Err.Raise vbObjectError - 999, , "Only single cell references allowed for 1st argument."
  CurrentCell = ActiveCell.Address
  For X = 1 To Cell.FormatConditions.Count
    With Cell.FormatConditions(X)
      If .Type = xlCellValue Then
        Select Case .Operator
          Case xlBetween:      Test = Cell.Value >= Evaluate(.Formula1) And Cell.Value <= Evaluate(.Formula2)
          Case xlNotBetween:  Test = Cell.Value <= Evaluate(.Formula1) Or Cell.Value >= Evaluate(.Formula2)
          Case xlEqual:        Test = Evaluate(.Formula1) = Cell.Value
          Case xlNotEqual:    Test = Evaluate(.Formula1) <> Cell.Value
          Case xlGreater:      Test = Cell.Value > Evaluate(.Formula1)
          Case xlLess:        Test = Cell.Value < Evaluate(.Formula1)
          Case xlGreaterEqual: Test = Cell.Value >= Evaluate(.Formula1)
          Case xlLessEqual:    Test = Cell.Value <= Evaluate(.Formula1)
        End Select
      ElseIf .Type = xlExpression Then
        Application.ScreenUpdating = False
        Cell.Select
        Test = Evaluate(.Formula1)
        Range(CurrentCell).Select
        Application.ScreenUpdating = True
      End If
      If Test Then
        On Error Resume Next
        If CellInterior Then
          DisplayedColor = IIf(ReturnColorIndex, .Interior.ColorIndex, .Interior.Color)
        Else
          DisplayedColor = IIf(ReturnColorIndex, .Font.ColorIndex, .Font.Color)
        End If
        If Err.Number <> 0 Then GoTo 1
        Exit Function
      End If
    End With
  Next
1:
  If CellInterior Then
    DisplayedColor = IIf(ReturnColorIndex, Cell.Interior.ColorIndex, Cell.Interior.Color)
  Else
    DisplayedColor = IIf(ReturnColorIndex, Cell.Font.ColorIndex, Cell.Font.Color)
  End If
  Err.Clear
End Function

---

Unfortunately this does not work either - no cells get locked (however, see below).

If I change .Borders.ColorIndex = xlNone to .Borders.ColorIndex = 16, the the following behaviour is observed:

• In 2007 the code still does not lock any cells/mergeareas, regardless of their colour.
• In 2010 it locks some cells/mergeareas, but not others, and also does not unlock some cells/mergeareas after they have been locked the first time - it all seems to be getting applied inconsistently.

For example, it locks K64:L64, but not K65:L65. It also locks all of the cells/mergeareas in the Combined Fund Heading 'table' (F125:W137), but does not Unlock them when they should be available (set F10 to "Standard Proposal (Research)" and L89 to either "FEC" or "Non-FEC").

In addition, the code takes an excessive amount of time (>2 minutes) to execute in 2007, causing Excel to become non-responsive (even being reported in task manager as 'Not Responding') during that period.

Essentially which cells you want to lock/unlock ? Like, you do not want to lock those cells which is having a border or colorindex having 48 etc..

Any cell with a light-grey displayed background (i.e. following conditional formatting) should be locked.

Any cell with a light-red/white displayed background should be unlocked.

The main complication arises from the fact that the displayed background of the cells will change based on the values in other cells (i.e. it will not always be the same cells that need to be locked).

Hi

IMHO, include all the conditions in the code and lock/unlock cells rather than depending on CF.