VBA Conditional Formatting .IconSets plus one other icon/symbol

  • Thread starter Thread starter L. Howard
  • Start date Start date
L

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.

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.
Click to expand...

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


Regards
Claus B.
 
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'
Click to expand...

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.
 
Hi again,



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






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.

--
Click to expand...

Yes, much nicer, Thanks again.

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
Click to expand...

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
 
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
Click to expand...

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
 
Hi Howard,



Am Wed, 5 Feb 2014 04:12:22 -0800 (PST) schrieb L. Howard:






have another look





Regards

Claus B.

--
Click to expand...

I don't know what could be better.

A question on the graphics/pictures in column Z.

Did you make them from the Shapes menu on the main ribbon or did you import them?

I am a bit surprised that Grafik works fine in the English version, I'm not sure what I would change it to for in English.

Howard

Shapes("Grafik " & .Value).Copy
 
Hi Howard,

Am Wed, 5 Feb 2014 10:01:41 -0800 (PST) schrieb L. Howard:
Did you make them from the Shapes menu on the main ribbon or did you import them?
Click to expand...

I created two CFs with 3 and 4 symbols and copied the icons out of the
cells.
If "Grafik " works for you no changing is needed. But if you copy the
icons as pictures and paste it you see how they are named in english
version.


Regards
Claus B.
 
Hi Howard,



Am Wed, 5 Feb 2014 10:01:41 -0800 (PST) schrieb L. Howard:






I created two CFs with 3 and 4 symbols and copied the icons out of the

cells.

If "Grafik " works for you no changing is needed. But if you copy the

icons as pictures and paste it you see how they are named in english

version.





Regards

Claus B.

--
Click to expand...


I put the word Pictures in for Grafik and it did not error but also would not import the icon when a number was entered.

So I went back to Grafik and then it did not work the same way using Picture failed.

I'll go back to SkyDrive and start a new workbook.

Howard
 
I put the word Pictures in for Grafik and it did not error but also would not import the icon when a number was entered.



So I went back to Grafik and then it did not work the same way using Picture failed.



I'll go back to SkyDrive and start a new workbook.



Howard
Click to expand...

All is working well!

Howard
 
Hi Howard,

Am Wed, 5 Feb 2014 10:29:55 -0800 (PST) schrieb L. Howard:
All is working well!
Click to expand...

that is fine. But this morning I had no time and no calm hand working
with Snipping Tool. Perhaps you make some nicer copies of the icons ;-)


Regards
Claus B.
 
Back
Top