Making "traffic lights"

[Juuljus]

Hi,

I have a column where are values 3,2,1 and I want to make a "traffic
light" indivator out of them. 3 is green, 2 is yellow and 1 is red. If
the cell is blank, it means yellow.
I made 3 ovals on the sheet.
The logical solution would be: (if 3 then green, (if 1 then red,), else
yellow)
But I can't code it.
The light indicator should be next to the cell that has the value.

 

[Juuljus]

Show me what you have in mind.

 

[Juuljus]

If you can figure out a way to show shapes that way then yes.

 

[NickHK]

Juuljus,
Would Conditional Formatting be sufficient ?

NickHK

 

[Bob Phillips]

That would be cells, not ovals, and just test the cell value within the
conditional formatting. Check CF in help.

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Juuljus]

I knew that. Colorful cell would look ugly. I need ovals.

 

[Juuljus]

OK, what will change the string "yellow" to shape named "yellow"?

Dim rlColor As String
With Worksheets("Temp").Range("AM10:AM40")
If rlColor = "yellow" Then

End If
If rlColor = "red" Then

Else

End If
End With

 

[Ken Johnson]

Hi Juuljus,
This isn't exactly what you want but it might give you some ideas.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
If Target.Address() <> "$A$1" Then
Exit Sub
End If
Dim Sstop As Shape, GetReady As Shape, Go As Shape
Set Sstop = ActiveSheet.Shapes("Stop")
Set GetReady = ActiveSheet.Shapes("Get Ready")
Set Go = ActiveSheet.Shapes("Go")
Select Case Range("A1")
Case 1
Sstop.Fill.ForeColor.SchemeColor = 10
GetReady.Fill.ForeColor.SchemeColor = 9
Go.Fill.ForeColor.SchemeColor = 9
Case 2
Sstop.Fill.ForeColor.SchemeColor = 9
GetReady.Fill.ForeColor.SchemeColor = 13
Go.Fill.ForeColor.SchemeColor = 9
Case 3
Sstop.Fill.ForeColor.SchemeColor = 9
GetReady.Fill.ForeColor.SchemeColor = 9
Go.Fill.ForeColor.SchemeColor = 11
End Select
End Sub

The worksheet has 3 circular autoshapes that have been named "Stop",
"Get Ready" and "Go"
The code resides in the ThisWorkbook Module and is automatically run
when A1's value changes (1=Stop is red, 2=Get Ready is yellow, 3=Go is
green)

I had to use Sstop as a variable name because Stop is not allowed.

Ken Johnson

 

[John]

Juuljus,

Have a look a the rough code below. You need to name the shapes as you add
them to the page so that you can refer to them later to change the colour.

You could have a worksheet change event (lookup change event in Help) to
read a current value of a cell and call the ChangeColour procedure.

Anyway, got to get on with my own work so hopefully this will help get you
started.

Best regards

John


Sub TrafficLights()

Dim shpRed As Shape
Dim shpOrange As Shape
Dim shpGreen As Shape

Set shpRed = ActiveSheet.Shapes.AddShape(msoShapeOval, 180#, 120#, 20#,
20#)
shpRed.Fill.ForeColor.SchemeColor = 10
shpRed.Name = "RedLight"
Set shpOrange = ActiveSheet.Shapes.AddShape(msoShapeOval, 180#, 141#,
20#, 20#)
shpOrange.Fill.ForeColor.SchemeColor = 52
shpOrange.Name = "OrangeLight"
Set shpGreen = ActiveSheet.Shapes.AddShape(msoShapeOval, 180#, 162#,
20#, 20#)
shpGreen.Fill.ForeColor.SchemeColor = 57
shpGreen.Name = "GreenLight"

End Sub

Sub ChangeColour()

ActiveSheet.Shapes("RedLight").Fill.ForeColor.SchemeColor = 12

End Sub

 

[Ken Johnson]

Hi Juuljus,
If you want the traffic lights to be operated according to the value in
the selected cell in column A then similar code can go into the
Workbook_SheetSelectionChange Sub of the ThisWorkbook Module:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal
Target As Range)
If Target.Column <> 1 Then
Exit Sub
End If
Dim Sstop As Shape, GetReady As Shape, Go As Shape
Set Sstop = ActiveSheet.Shapes("Stop")
Set GetReady = ActiveSheet.Shapes("Get Ready")
Set Go = ActiveSheet.Shapes("Go")
Select Case Target
Case 1
Sstop.Fill.ForeColor.SchemeColor = 10
GetReady.Fill.ForeColor.SchemeColor = 9
Go.Fill.ForeColor.SchemeColor = 9
Case 2
Sstop.Fill.ForeColor.SchemeColor = 9
GetReady.Fill.ForeColor.SchemeColor = 13
Go.Fill.ForeColor.SchemeColor = 9
Case 3
Sstop.Fill.ForeColor.SchemeColor = 9
GetReady.Fill.ForeColor.SchemeColor = 9
Go.Fill.ForeColor.SchemeColor = 11
End Select
End Sub
Only the first and eigth code lines have been changed.
If you have a sequence of 1's, 2's and 3's down column A the traffic
lights will change is you change the cell selected in column A

Ken Johnson

 

[Ken Johnson]

Hi Juuljus,
Just noticed you want the traffic lights to move to the selection
position.Try this for 1's, 2's, 3's and blanks in column A. I've
changed the Select Case to deal with values other than 1,2,or 3 to give
yellow light.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal
Target As Range)
If Target.Column <> 1 Then
Exit Sub
End If
Dim Sstop As Shape, GetReady As Shape, Go As Shape
Set Sstop = ActiveSheet.Shapes("Stop")
Set GetReady = ActiveSheet.Shapes("Get Ready")
Set Go = ActiveSheet.Shapes("Go")
Sstop.Top = Target.Top
GetReady.Top = Target.Top + Sstop.Height
Go.Top = Target.Top + GetReady.Height + Sstop.Height
Select Case Target
Case 1
Sstop.Fill.ForeColor.SchemeColor = 10
GetReady.Fill.ForeColor.SchemeColor = 9
Go.Fill.ForeColor.SchemeColor = 9
Case 2
Sstop.Fill.ForeColor.SchemeColor = 9
GetReady.Fill.ForeColor.SchemeColor = 13
Go.Fill.ForeColor.SchemeColor = 9
Case 3
Sstop.Fill.ForeColor.SchemeColor = 9
GetReady.Fill.ForeColor.SchemeColor = 9
Go.Fill.ForeColor.SchemeColor = 11
Case Else
Sstop.Fill.ForeColor.SchemeColor = 9
GetReady.Fill.ForeColor.SchemeColor = 13
Go.Fill.ForeColor.SchemeColor = 9
End Select
End Sub

I will mail you a copy of the worksheet. Make sure security setting is
medium so that macro will work.

Ken Johnson

 

[Juuljus]

Thanks to everybody who have replyed.

I have messed around with all of the codes, but can't get it to work.
Basically I have a column where I have the indicators, for example:

column_name
red
green
green
yellow
yellow
red

I need to changes those strings to an oval shape with correct color.
red changes to a red oval, green to a green oval etc.

Juuljus

 

[Andy Pope]

Use the wingdings font on the traffic light cell.
Cell contains the l character (lower case L)
Condition formatting based on cell to left for various colours.

Cheers
Andy

 

[Juuljus]

Good idea Andy.

I have never used the Conditional formatting option.
How can I make the cell I want to color (the one with the l) decide
which color by the cell that has "yello", "green" and "red" strings?

Juuljus

 

[Bob Phillips]

Select the traffic lights, but where the cells with yello, green, red let's
say start at A1

Menu Format>Conditional Formatting
Change Condition 1 to Formula Is
Add a formula of =A1="red"
Click the Format button
Select the Font Tab
Select red from the Color dropdown
OK
OK

Second condition

Click Add
Change Condition 2 to Formula Is
Add a formula of =A1="yello"
Click the Format button
Select the Font Tab
Select yellow from the Color dropdown
OK
OK

Second condition

Click Add
Change Condition 2 to Formula Is
Add a formula of =A1="green"
Click the Format button
Select the Font Tab
Select green from the Color dropdown
OK
OK

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Andy Pope]

Thanks Bob. If you default the cell color to Green you can get away with
only 2 conditions.

Cheers
Andy

 

[Bob Phillips]

Hi Andy,

I've got it filed away in a drawer for such occasions )

I only ever bother with the default colour when I want 4.

Bob

 

[Juuljus]

Hi,

Thanks to everyone!
I worked fine with the conditional formating, but as I need to do an
advanced filtering on that, it changes the color back to default
(black). Is there a way to make it work?

Juuljus

 

[Juuljus]

OK, did some searching and as I understand, then filtering cancels any
kind of formatting and only takes the data. Therefor a quick and easy
way to solve the problem is useless and I'm back at square one.
I think I need to go back to the initial idea of shapes.
So, the code so far given (BTW big thanks to everyone for that) hasn't
helped me. I think that I have the logic, but can't code:
we have a string variable and 3 shape variables:
Dim shpGreen As Shape, shpRed As Shape, shpYellow As Shape, rlcolor As
String
Now the rlcolor should take the value from a range (my range is
AM10:AM30) where are "yellow", "green" and "red".
After that should come a For cycle, rlcolor takes the values from the
range one by one and then does a If (or Case) cycle with the condition
to make a correctly colored shape to the next cell (if we are in AM10,
then into AN10).

br,
Juuljus

 

[Ken Johnson]

Hi Juuljus,

Does this sound right.....

Each cell from AN10 down to AN30 is to have a colored circle and its
color is determined by the text in the cell to its immediate left. So
if AM10 = "yellow" then the circle in AN10 has a yellow fill. If AM11 =
"red" then the circle in AN11 has a red fill and so on down to row 30?.

Ken Johnson