View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default Drawing a Circle if a different cell has data

Sub test2()
Dim bCondition As Boolean
Dim n As Long
Dim rngY As Range
Dim rngC, cel As Range
Dim shp As Shape

Set rngC = Range("A25:A32") ' test cells
Set rngY = Range("G25:G32") 'Y circle cells

rngC.Value = 0

n = 0
bCondition = False
For Each cel In rngY
n = n + 1
On Error Resume Next
Set shp = Nothing
Set shp = ActiveSheet.Shapes("Yes" & cel.Address(0, 0))

If shp Is Nothing Then
Set shp = ActiveSheet.Shapes.AddShape(msoShapeOval, 1, 1, 1, 1)
On Error GoTo 0
With shp
.Name = "Yes" & cel.Address(0, 0)
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
End With
End If
On Error GoTo 0

bCondition = rngC(n, 1) = 1 ' test is true if the test cell = 1 but change
With rngY(n, 1)
shp.Left = .Left + .Width / 2 - .Height / 2
shp.Top = .Top
shp.Width = .Height
shp.Height = .Height
shp.Fill.Visible = msoFalse
shp.Line.Visible = bCondition

.Value = "Y"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Next
End Sub

Regards,
Peter T

"Steve R." wrote in message
...

Peter
This is close to what I need, have to expand on my original post though.
This will be for a range of cells G25 - G32 and the cell I am testing is

A25
- A32 How would that change the code you posted?

Thanks