Conditional formatting on autoshapes

[Freshman]

Dear experts,

Jacob Skaria, MVP wrote me a marco below for the solution of conditional
formatting on autoshapes. As Jacob's macro refers the value of A1 to the
default name of the autoshapes, such as: the value of A1 = 2, then the
autoshape named "Oval 2" will be changed to colour green. However, I want the
value of A1 refers to the text inside Oval 2 instead, such as: value A1 =
table and the text inside Oval 2 = table, then autoshpae Oval 2 will turn
into colour green. How can I get it done? Please kindly advise.

Thanks in advance.

QUOTE

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

UNQUOTE

 

[Bernie Deitrick]

Freshman,

You can loop through the shapes looking for the text: this version will only show the fill of the
shape with the matching text,

Private Sub Worksheet_Change(ByVal target As Range)
Dim sh As Shape

If target.Address <> "$A$1" Then Exit Sub

For Each sh In ActiveSheet.Shapes
If sh.TextFrame.Characters.Text = target.Value Then
With sh
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 17
End With
Else
sh.Fill.Visible = msoFalse
End If
Next sh

End Sub



HTH,
Bernie
MS Excel MVP

 

[Jacob Skaria]

Hi again

In the first place I am not an MVP; but just another contributor.

Try the below...which will look out for any shapes and if the text matches
will format as required.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Shape, intComp As Integer
If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
For Each sh In ActiveSheet.Shapes
intComp = StrComp(sh.TextFrame.Characters.Text, Target.Text, vbTextCompare)
With sh
..TextFrame.Characters.Font.Bold = (intComp = 0)
..TextFrame.Characters.Font.ColorIndex = IIf(intComp, xlAutomatic, 2)
..Fill.ForeColor.SchemeColor = IIf(intComp, 1, 17)
End With
Next
End If
End Sub


If this post helps click Yes

 

[Freshman]

Hi Bernie,

Thanks for your tips. What about if I input numbers into the autoshapes
instead of text. How you change the macro? Please kindly advise.

Thanks a million.

 

[Bernie Deitrick]

The autoshapes always have text. You could try this - change

If sh.TextFrame.Characters.Text = target.Value Then

to

If sh.TextFrame.Characters.Text = CStr(target.Value) Then

You could also format your target cell as string.

HTH,
Bernie
MS Excel MVP

 

[Freshman]

Hi Bernie,

Sorry to bother you. I found a dialogue box "Runtime error 13, Type
mismatch" even I change the macro statement you teach me. Is there a way to
correct?

Thanks in advance.

 

[Bernie Deitrick]

Freshman,

I cannot get that error. What is the format of cell A1, and what value or text are you using?
Could you also post all of your code - perhaps that is the source of the error.

HTH,
Bernie
MS Excel MVP

 

[Freshman]

Hi Bernie,

The code below is exactly the same (I just copy and paste) you wrote me
before. The format in A1, no matter I set it as "General", "Number" or
"Text", the same error message appeared.

Sorry to bother you. Thanks.

Private Sub Worksheet_Change(ByVal target As Range)
Dim sh As Shape

If target.Address <> "$A$1" Then Exit Sub

For Each sh In ActiveSheet.Shapes
If sh.TextFrame.Characters.Text = target.Value Then
With sh
..Fill.Visible = msoTrue
..Fill.Solid
..Fill.ForeColor.SchemeColor = 17
End With
Else
sh.Fill.Visible = msoFalse
End If
Next sh

End Sub

 

[Freshman]

Hi Bernie,

Forget to write what the text I put inside the auotshpaes. It is simply the
numbers, such as 1, 2, 5, 60, 72 etc. I want if I input 1 into A1, then the
autoshape contains the text "1" will turn to green colour.

Thanks.

 

[Bernie Deitrick]

Freshman,

Contact me privately - make the obvious changes to my email address when you reply - and I will send
you a working version.

HTH,
Bernie
MS Excel MVP

 

[Freshman]

Hi Bernie,

Can you give me your email address so that I can send the file to you? Many
thanks.

 

[Bernie Deitrick]

deitbe @ consumer dot org


HTH,
Bernie
MS Excel MVP