Conditional Formatting on Autoshape

[Freshman]

Dear experts,

I've 50 autoshapes of circles numbering from 1 to 50. I want if the value of
cell A1 is, for example, 25, then the autoshape of number 25 will be filled
with green colour and the font will be changed to bold white colour. This
method should be applied to other autoshapes. Can it be done? If yes, please
kindly advise how.

Thanks in advance.

 

[Jacob Skaria]

You will have to go for a VBA solution. Try the below. Select the sheet tab
which you want to work with. Right click the sheet tab and click on 'View
Code'. This will launch VBE. Paste the below code to the right blank portion.
Get back to to workbook and try out.

I tried with 10 autoshapes Oval named 'Oval 1', 'Oval 2' etc; upto 'Oval 10'

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Shape, intCount As Integer
If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
For intCount = 1 To 10
Set sh = ActiveSheet.Shapes("Oval " & intCount)
With sh
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = IIf(intCount = Target, 17, 1)
End With
ActiveSheet.DrawingObjects("Oval " & intCount).Font.ColorIndex = _
IIf(intCount = Target, 2, xlAutomatic)
ActiveSheet.DrawingObjects("Oval " & intCount).Font.Bold = (intCount = Target)
Next
End If
End Sub


If this post helps click Yes

 

[Freshman]

Hi Jacob,

I found that if the numbers of autoshapes are not consecutive (such as 1, 2,
4, 5...), a runtime error message pop out. How can I fix intCount numbers
problem. Please kindly advise.

Thanks again.

 

[Jacob Skaria]

Try the below

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Shape, intCount As Integer
If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
For intCount = 1 To 10
On Error Resume Next
Set sh = ActiveSheet.Shapes("Oval " & intCount)
If Not sh Is Nothing Then
With sh
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = IIf(intCount = Target, 17, 1)
End With
ActiveSheet.DrawingObjects("Oval " & intCount).Text = "Hi" & intCount
ActiveSheet.DrawingObjects("Oval " & intCount).Font.ColorIndex = _
IIf(intCount = Target, 2, xlAutomatic)
ActiveSheet.DrawingObjects("Oval " & intCount).Font.Bold = (intCount = Target)
End If
Set sh = Nothing
Next
End If
End Sub

If this post helps click Yes

 

[Freshman]

Hi Jacob,

Thanks for your great help once again.

One more question is, right now the value of A1 is refer to the default name
of an autoshpe, such as "Oval 1, Oval 2...". If I want the value of A1 refer
to the text inside "Oval 1" such as "1" or "2" etc. Is it posiible?

Thanks.