Conditional Formatting Icons

C

Coolness

Is there a way to create a custom Icon under conditional formatting. I am
trying to put a conditional format where if a number is between a certain
range it will assign a gold star to that cell. Is there any other way to do
this?

Thanks
 
B

Bernie Deitrick

Coolness,

No conditional formatting will do that, but you could use a macro: this assumes that the sheet has
goldstar shape named "GoldStar", and the gold stars are placed on cells in column E that are greater
than 95...

Sub PutGoldStars()
Dim myCell As Range
Dim myR As Range
Dim mySh As Shape

Set mySh = ActiveSheet.Shapes("GoldStar")
Set myR = Range("E1:E100")

For Each myCell In myR
If myCell.Value > 95 Then
On Error Resume Next
ActiveSheet.Shapes("Star" & myCell.Address).Delete
mySh.Copy
myCell.Select
ActiveSheet.Paste
Selection.ShapeRange.Left = myCell.Left
Selection.ShapeRange.Top = myCell.Top
Selection.Name = "Star" & myCell.Address
End If
Next myCell
End Sub

HTH,
Bernie
MS Excel MVP
 
C

Coolness

I know I soud stupid, but how do I name a shape, so it knows what to put in
the cell? It doesn't recognize Gold Star. How can I create and name that
shape?

Thanks Again
 
B

Bernie Deitrick

Coolness,

Use the drawing toolbar to insert the star shape. Then, select the shape by clicking on it, and type
the name GoldStar into the name box above cell A1. When you first select the shape, the name box
will show the shape's original name, along the lines of "AutoShape 1"

HTH,
Bernie
MS Excel MVP
 
C

Coolness

Worked perfectly. Thanks very much!

Bernie Deitrick said:
Coolness,

Use the drawing toolbar to insert the star shape. Then, select the shape by clicking on it, and type
the name GoldStar into the name box above cell A1. When you first select the shape, the name box
will show the shape's original name, along the lines of "AutoShape 1"

HTH,
Bernie
MS Excel MVP
Click to expand...
 
C

Coolness

I have one additional thing Im wondering if you can assist me with. What I'm
trying to do it set up a tracking chart where certain performance assigns a
different symbol, i.e. If someone beats both last years number and this years
goal, it will assign a GOLDSTAR in that cell. If they beat last years
number, but not this years goal, it will assign a black dot in that cell. If
they don't beat last years number it will assign a red dot. I will be adding
additional spreadsheets that contain that data, i.e. last years number, this
years goal and their actual number achieved. I am hoping that this macro can
look at that data and determine which symbol to assign. Will I need multiple
macros or will one take care of it? I tried to just copy the goldstar macro
formula again and named a different symbol with a different value, but it
gives me errors, so I don't know how to make the formula flow. Any
assistance would be greatly appreciated.

Thanks very much!
 
B

Bernie Deitrick

Coolness,

You don't really discuss worksheet structure, but below is an example where the symbol used is based
on values in two columns, C& D. (Assumes you have Goldstar, Silverstar, Bronzestar, and Blackdot
shapes on the activesheet.) Your comparison can be just about anything - the limits (95,90, etc)
can also be cells, either constant cells or cells on the same row as the cell needing the symbol.
If you need help with specifics, repost with specific info about where the values are relative to
the cell needing the symbol, and which comparisons are important.

HTH,
Bernie
MS Excel MVP

Sub PutStars()
Dim myCell As Range
Dim myR As Range
Dim mySh As Shape

Set myR = Range("C5:C18")

For Each myCell In myR
On Error Resume Next
ActiveSheet.Shapes("Symbol" & myCell.Address).Delete
If myCell.Value >= 95 And myCell.Offset(0, 1).Value >= 95 Then
Set mySh = ActiveSheet.Shapes("GoldStar")
mySh.Copy
GoTo PasteShape
End If
If myCell.Value >= 95 And myCell.Offset(0, 1).Value >= 90 Then
Set mySh = ActiveSheet.Shapes("Silverstar")
mySh.Copy
GoTo PasteShape
End If
If myCell.Value >= 90 And myCell.Offset(0, 1).Value >= 90 Then
Set mySh = ActiveSheet.Shapes("Bronzestar")
mySh.Copy
GoTo PasteShape
End If
If myCell.Value < 90 Or myCell.Offset(0, 1).Value < 90 Then
Set mySh = ActiveSheet.Shapes("Blackdot")
mySh.Copy
GoTo PasteShape
End If

PasteShape:
myCell.Select
ActiveSheet.Paste
Selection.ShapeRange.Left = myCell.Left
Selection.ShapeRange.Top = myCell.Top
Selection.Name = "Symbol" & myCell.Address
Next myCell
End Sub
 
C

Coolness

With you assistance I have been able to do just about everything I need. I
have one additional issue. The spreadsheet will need to reference the range
of ("c9,C11,C13, etc... when I got to like E95 I received an error, I guess
there were too many numbers in that formula. The spreadsheet is set-up to
reference every other cell, because of spacing, etc. Is there a way to have
the macro do nothing if the cell does not contain a value? If so it will not
try to put something in the blank cell. Thanks again for your assistance.

Sub PutStars()
Dim myCell As Range
Dim myR As Range
Dim mySh As Shape

Set myR = Range("c9,c11:E95")

For Each myCell In myR
On Error Resume Next
ActiveSheet.Shapes("Symbol" & myCell.Address).Delete
If myCell.Value = 3 Then
Set mySh = ActiveSheet.Shapes("GoldStar")
mySh.Copy
GoTo PasteShape
End If
If myCell.Value = 2 Then
Set mySh = ActiveSheet.Shapes("Blackdot")
mySh.Copy
GoTo PasteShape
End If
If myCell.Value = 1 Then
Set mySh = ActiveSheet.Shapes("Reddot")
mySh.Copy
GoTo PasteShape
End If
If myCell.Value = 0 Then
Set mySh = ActiveSheet.Shapes("Blank")
mySh.Copy
GoTo PasteShape
End If

PasteShape:
myCell.Select
ActiveSheet.Paste
Selection.ShapeRange.Left = myCell.Left
Selection.ShapeRange.Top = myCell.Top
Selection.Name = "Symbol" & myCell.Address
Next myCell
End Sub
 
B

Bernie Deitrick

Coolness,

There are two ways to address this:

Change

PasteShape:
myCell.Select
ActiveSheet.Paste
Selection.ShapeRange.Left = myCell.Left
Selection.ShapeRange.Top = myCell.Top
Selection.Name = "Symbol" & myCell.Address
Next myCell

to

GoTo NoShape
PasteShape:
myCell.Select
ActiveSheet.Paste
Selection.ShapeRange.Left = myCell.Left
Selection.ShapeRange.Top = myCell.Top
Selection.Name = "Symbol" & myCell.Address
NoShape:
Next myCell

This will make the code skip the pasting of the shape unless the values meet
your exact requirement.


OR Change

Set myR = Range("c9,c11:E95")
For Each myCell In myR

To

Set myR = Range("c9,c11:E95")
For Each myCell In myR
If myCell.Row Mod 2 = 0 Then GoTo NoShape

and put the NoShape: label in the same place as the above example. Of
course, if you need to skip column D, that would be another slight change (I
wasn't sure excatly what you meant by "reference every other cell")

HTH,
Bernie
MS Excel MVP
 
Top