VBA Conditional Formatting .IconSets plus one other icon/symbol

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
 
C

Claus Busch

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.
 
C

Claus Busch

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.
 
L

L. Howard

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
 
L

L. 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
 
L

L. 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
 
L

L. Howard

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
 
C

Claus Busch

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.
 
L

L. Howard

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
 
L

L. 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
 
C

Claus Busch

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.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
Finding the right style field in VBA 0
Development combinations with exclusion of columns 0
Development combinations with exclusion of columns 0
Use BeforeDoubleClick to place 1 or 4 character in a cell 1
Runtime error 13 : type mismatch 2
i to = column in Formula 19
Document Merge Formatting Issue 0

Top