Locking cells based on color in doc with merged cells

Hi!
I have created a simple script that is supposed to lock all the cells that don't have a specific color. It worked fine on my test document but when I tried it on the excel project that I designed it for I got the error message "Run-time error '1004': Unable to set the locked property of the Range class." I believe that it is the merged cells are the cause of the problem. Is it possible to edit the script so it could work on merged cells as well.

Sub Protection()
For Each c In ActiveSheet.UsedRange
Debug.Print c.Interior.ColorIndex
If c.Interior.ColorIndex = 36 Then
c.Locked = False
Else
c.Locked = True
End If
Next c
End Sub

Kind Regards
Lars

Hi spuds,

I highly encourage you to use 'Option Explicit'. To prevent typos from ruining days and weeks of work 'Option Explicit' is NEEDED at the top of each code module. This prevents errors caused by missspellings and FORCES every variable to be DECLARED (e.g. dim i as Integer).
http://www.cpearson.com/excel/DeclaringVariables.aspx

Try the following tested using Excel 2003:

Sub Protection()

  Dim c As Range
  Dim myMergedRange As Range
  Dim iColorIndex As Integer

  For Each c In ActiveSheet.UsedRange
    iColorIndex = c.Interior.ColorIndex
    Debug.Print c.Address(False, False) & "  " & iColorIndex
    
    If IsMerged(c) = True Then
      If IsTopLeftCellOfMergedRange(c) Then
        Set myMergedRange = c.MergeArea
        If iColorIndex = 36 Then
          myMergedRange.Locked = False
        Else
          myMergedRange.Locked = True
       End If
     End If
    Else
      If iColorIndex = 36 Then
        c.Locked = False
      Else
        c.Locked = True
      End If
    End If
   
  Next c
  
  'Clear object pointer
  Set myMergedRange = Nothing

End Sub

Function IsMerged(rCell As Range) As Boolean
  'Returns True if the input cell is part of a 'merged cell'
  IsMerged = rCell.MergeCells
End Function

Function IsTopLeftCellOfMergedRange(rCell As Range) As Boolean
  'Returns True if the input cell is the 'top left' cell of a 'merged cell'
  Dim r As Range
  Dim rStart As Range

  'Only process if the input cell is part of a 'merged cell'
  If IsMerged(rCell) = True Then
  
    'Get the 'top left' cell of the merged area
    Set r = rCell.MergeArea
    Set rStart = r.Cells(1, 1)
    
    'Return True if this cell is the 'top left' cell
    If rStart.Address = rCell.Address Then
      IsTopLeftCellOfMergedRange = True
    End If
  
    'Clear range objects
    Set r = Nothing
    Set rStart = Nothing
  End If
  
End Function

Lewis

Thanks a million!
The code worked like a charm.
Thank you for the great link, helped a lot in improving my understanding in VBA.
Cheers
Lars