VBA code error with Protection turned on - help please

[Fred]

I am using Excel 97-SR2.

The code below is used to set a cell to a particular colour, dependent
upon the value entered. The cell (in range A3:IV3) is used as an
indicator to show the status of the data being entered as follows
R - Red
A - Amber
G - Green
P - Pending Completion
C - Complete
H - On hold
D - Draft

The 2 subroutines allow the data to be either typed in or selected from
a validation list (a Named list on a separate "Lookups" worksheet in
the same spreadsheet), the colours are set by macro to get around the
Conditional formatting limit of 3/4 colours.

All was working well until it was decided to protect some of the other
cells on the worksheet (Format, Cells, Protection, Locked/Unlocked) and
then Tools, Protection, Protect Sheet.

Once protection was turned on, change to cells that caused changes to
the contents of other cells resulted in an error 1004 message to be
displayed, "Unable to set the ColorIndex property of the Interior
class" in the Worksheet_Calculate subroutine at the line
"cell.Interior.ColorIndex = vColor".

Can anyone offer a pointer or, better still, a solution, to the problem
please ?

Thanks
Fred Newton

Private Sub Worksheet_Calculate()

Dim vColor As Long
Dim fColor As Long
Dim vPattern As Long
Dim vPatternColorIndex As Long
Dim cell As Range

fColor = 1
vColor = 15
vPattern = xlSolid
vPatternColorIndex = xlAutomatic

If ActiveSheet.Name = "Demand" Then
For Each cell In Intersect(Range("A3:IV3"), ActiveSheet.UsedRange)
With cell
Select Case LCase(.Text)
Case "r"
vColor = 3
fColor = 2
Case "a"
vColor = 44
' fColor = 1
Case "g"
vColor = 10
fColor = 2
Case "d"
vColor = 10
fColor = 2
vPattern = xlLightDown
vPatternColorIndex = 2
Case "p"
vPatternColorIndex = 2
vPattern = xlLightDown
vColor = 41
Case "c"
vColor = 5
fColor = 2
Case "h"
vColor = 9
fColor = 2
Case ""
vColor = 15 'xlColorIndexNone
Case Else
vColor = 15 'xlColorIndexNone
fColor = xlColorIndexAutomatic
vPattern = xlSolid
vPatternColorIndex = xlAutomatic
End Select
cell.Interior.ColorIndex = vColor
cell.Font.ColorIndex = fColor
cell.Interior.Pattern = vPattern
cell.Interior.PatternColorIndex = vPatternColorIndex
End With
Next cell
End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Fred Newton, 2004-07-27

Dim vColor As Long
Dim fColor As Long
Dim vPattern As Long
Dim vPatternColorIndexIndex As Long
Dim cRange As Range
Dim cell As Range

'***************** check range ****
Set cRange = Intersect(Range("A3:IV3"), (Target(1)))
If cRange Is Nothing Then Exit Sub

fColor = 1
vPattern = xlSolid
vPatternColorIndex = xlAutomatic

For Each cell In cRange
With cell
Select Case LCase(.Text)
Case "r"
vColor = 3
fColor = 2
Case "a"
vColor = 44
Case "g"
vColor = 10
fColor = 2
Case "d"
vColor = 10
fColor = 2
vPattern = xlLightDown
vPatternColorIndex = 2
Case "c"
vColor = 5
fColor = 2
Case "p"
vPatternColorIndex = 2
vPattern = xlLightDown
vColor = 41
Case "h"
vColor = 9
fColor = 2
Case ""
vColor = 15 'xlColorIndexNone
Case Else
vColor = 15 'xlColorIndexNone
fColor = xlColorIndexAutomatic
vPattern = xlSolid
vPatternColorIndex = xlAutomatic
End Select
cell.Interior.ColorIndex = vColor
cell.Font.ColorIndex = fColor
cell.Interior.Pattern = vPattern
cell.Interior.PatternColorIndex = vPatternColorIndex
End With
Next cell

End Sub

 

[Celt]

Hiya Fred.

Don't know if you solved your problem yet, but try dropping this into
your code (I have no idea if it will work with Excel 97):

ActiveSheet.Unprotect Password:="password"

*** your macro ***

ActiveSheet.Protect Password:="password"
ActiveSheet.EnableSelection = xlNoRestrictions

If you don't have a password then ust delete
"Password:="password""....otherwise stick in your specific password.

Where you drop it in is the question. I am guessing the unprotect
statement would go right after you identify your "ActiveSheet". The
protect statement would go right before your last "End Sub".

I use Excel2003 and this works fine for me, allowing me to run macros
on protected sheets.

good luck!