Hi. I have a macro that will place a shape (either a
circle or rectange) in several cells based on the value
in the cell.

I want the user to be able to change the value of the
cell, but I do not want them to be able to select the
shape that is in the cell.

Could someone tell me how to accomplish this? My code is
included below.

Thanks,
Mike.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim myrange As Range
Dim myCell As Range
Dim myOval As Shape
Dim mySquare As Shape
Dim pbar, lcl, ucl
Dim n As Integer
Dim pbarn As Variant
Dim lastRow As Integer
'This statement find the last row of the spreadsheet
lastRow = Rows.Find(What:="Percentage").Row
Set myrange = Worksheets("Practice").Range("c26:y" &
lastRow - 2)
For Each myCell In myrange.Cells
'The following with statement calculates the control
limits for each individual
'entry on the chart and places red squares or green
circles around the entry.
With myCell
pbar = Range("A" & .Row)
n = myrange(lastRow - 26, .Column - 2)
pbarn = pbar * n
lcl = pbarn - 2.58 * Sqr(pbarn * (1 -
pbar))
ucl = pbarn + 2.58 * Sqr(pbarn * (1 -
pbar))
If .Value < lcl Then
Set myOval = .Parent.Shapes.AddShape
(Type:=msoShapeOval, _
Top:=.Top + 1, Left:=.Left + 2,
Width:=.Width - 4, Height:=.Height - 2)
myOval.Fill.Visible = msoTrue
myOval.Line.Weight = 1.5
myOval.Line.ForeColor.SchemeColor = 17
myOval.Fill.ForeColor.SchemeColor = 11
myOval.Fill.Transparency = 0.85
End If
If .Value ucl Then
Set mySquare = .Parent.Shapes.AddShape
(Type:=msoShapeRectangle, _
Top:=.Top + 1.5, Left:=.Left + 1.5,
Width:=.Width - 3, Height:=.Height - 3)
mySquare.Fill.Visible = msoTrue
mySquare.Line.Weight = 1.5
mySquare.Line.ForeColor.SchemeColor = 10
mySquare.Fill.ForeColor.SchemeColor = 10
mySquare.Fill.Transparency = 0.85
End If
End With
Next myCell

Set myrange = Worksheets("Practice").Range("c39:y" &
lastRow)
For Each myCell In myrange.Cells
'The following with statement calculates the control
limits for the totals row
' and places red squares or green circles around the
entry.
With myCell
pbar = Range("A" & lastRow - 2)
n = myrange(0, .Column - 2)
pbarn = pbar * n
If n 0 Then
lcl = pbar - 2.58 * Sqr(pbar * (1 -
pbar) / n)
ucl = pbar + 2.58 * Sqr(pbar * (1 -
pbar) / n)

If .Value < lcl Then
Set myOval = .Parent.Shapes.AddShape
(Type:=msoShapeOval, _
Top:=.Top + 1, Left:=.Left + 2,
Width:=.Width - 4, Height:=.Height - 2)
myOval.Fill.Visible = msoTrue
myOval.Line.Weight = 1.5
myOval.Line.ForeColor.SchemeColor = 17
myOval.Fill.ForeColor.SchemeColor = 11
myOval.Fill.Transparency = 0.85
End If
If .Value ucl Then
Set mySquare = .Parent.Shapes.AddShape
(Type:=msoShapeRectangle, _
Top:=.Top + 1.5, Left:=.Left +
1.5, Width:=.Width - 3, Height:=.Height - 3)
mySquare.Fill.Visible = msoTrue
mySquare.Line.Weight = 1.5
mySquare.Line.ForeColor.SchemeColor = 10
mySquare.Fill.ForeColor.SchemeColor = 10
mySquare.Fill.Transparency = 0.85
End If
End If
End With
Next myCell
End Sub