The values in Range("C1:D12") will hand entered as 1, 2, 3 or 4 only. Cells can be blank.
When I run the code the range is nicely CF'ed to;

1 = Red Diamond
2 = Yellow triangle
3 = Green circle
4 = Green Circle
Blank = 'no icon'

The problem is I want the 4 to = the icon green check MARK not a green CIRCLE. However, the green check mark is part of the xl3Symbol icon set.

I would be happy with a Blue Star if I could make that happen, as long as it shows in the cell like the xl3Signs do.

Anyone have a suggestion?

Thanks.
Howard


Option Explicit

Sub CreateIconSetCF()
Dim cfIconSet As IconSetCondition

Range("C1:D12").Select
On Error Resume Next

Set cfIconSet = Selection.FormatConditions.AddIconSetCondition

cfIconSet.IconSet = ActiveWorkbook.IconSets(xl3Signs)

With cfIconSet.IconCriteria(1)
.Type = xlConditionValueNumber
.Value = 1
.Operator = 3
End With
With cfIconSet.IconCriteria(2)
.Type = xlConditionValueNumber
.Value = 2
.Operator = 3
End With
With cfIconSet.IconCriteria(3)
.Type = xlConditionValueNumber
.Value = 3
.Operator = 3
End With

With cfIconSet.IconCriteria(4)
.Type = xlConditionValueNumber
.Value = 4
.Operator = 4
End With

End Sub

Hi Howard,

Am Wed, 5 Feb 2014 00:03:19 -0800 (PST) schrieb L. Howard:

The values in Range("C1:D12") will hand entered as 1, 2, 3 or 4 only. Cells can be blank.
When I run the code the range is nicely CF'ed to;

1 = Red Diamond
2 = Yellow triangle
3 = Green circle
4 = Green Circle
Blank = 'no icon'

The problem is I want the 4 to = the icon green check MARK not a green CIRCLE. However, the green check mark is part of the xl3Symbol icon set.

with CF and xl3Symbol you can't get 4 symbols.
Have a look he
http://www.contextures.com/xlCondFormat03.html#Shape
for "Create Coloured Shapes"


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Howard,

Am Wed, 5 Feb 2014 00:03:19 -0800 (PST) schrieb L. Howard:

1 = Red Diamond
2 = Yellow triangle
3 = Green circle
4 = Green Circle
Blank = 'no icon'

copy the icons as pictures and insert them in order in Z1:Z4
Then with Worksheet_Change event:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C1:D12")) Is Nothing Or _
Target.Count 1 Then Exit Sub

With Target
If .Value 0 And .Value < 5 Then
Shapes("Grafik " & .Value).Copy
.Select
ActiveSheet.Paste
End If
End With
End Sub

In German the shapes are named "Grafik" with an index. Change the name
for your english system.


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Howard,

have a look:
https://skydrive.live.com/#cid=9378A...121822A3%21326
for workbook "Icons"


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi again,

Am Wed, 5 Feb 2014 10:59:00 +0100 schrieb Claus Busch:

https://skydrive.live.com/#cid=9378A...121822A3%21326

after posting the link I improved the code that you can change existing
values.
Make sure that you have the newest version.


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Wednesday, February 5, 2014 3:07:31 AM UTC-8, Claus Busch wrote:
Hi again,



Am Wed, 5 Feb 2014 10:59:00 +0100 schrieb Claus Busch:



https://skydrive.live.com/#cid=9378A...121822A3%21326



after posting the link I improved the code that you can change existing

values.

Make sure that you have the newest version.





Regards

Claus B.

--

Yes, much nicer, Thanks again.

Howard

On Wednesday, February 5, 2014 1:59:00 AM UTC-8, Claus Busch wrote:
Hi Howard,



have a look:

https://skydrive.live.com/#cid=9378A...121822A3%21326

for workbook "Icons"





Regards

Claus B.

--

Thanks, Claus.

That should get me going, I'll work on a way to clear the shape if the cell is returned to blank.

Regards,
Howard

Thanks, Claus.



That should get me going, I'll work on a way to clear the shape if the cell is returned to blank.



Regards,

Howard

This little addition seems to work well to blank out a cell.

Plus a small adjustment to the Top and Left.

Thanks for the heavy lifting, appreciate it.

Regards,
Howard

On Wednesday, February 5, 2014 4:11:04 AM UTC-8, L. Howard wrote:
Thanks, Claus.







That should get me going, I'll work on a way to clear the shape if the cell is returned to blank.







Regards,



Howard



This little addition seems to work well to blank out a cell.



Plus a small adjustment to the Top and Left.



Thanks for the heavy lifting, appreciate it.



Regards,

Howard

Forgot to post the code, duh.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C1:D12")) Is Nothing Or _
Target.Count 1 Then Exit Sub

Dim shp As Shape

For Each shp In ActiveSheet.Shapes
If shp.Name = "Shp" & Target.Address(0, 0) Then
shp.Delete
End If
Next

With Target
If .Value 0 And .Value < 5 Then
For Each shp In ActiveSheet.Shapes
If shp.Name = "Shp" & Target.Address(0, 0) Then
shp.Delete
Exit For
End If
Next
Shapes("Grafik " & .Value).Copy
.Select
ActiveSheet.Paste
With Selection
.Top = Target.Top + 0.5
.Left = Target.Left + 4
.Name = "Shp" & Target.Address(0, 0)
End With
.Select
End If
End With

End Sub