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.

[NickHK]

Juuljus,
Would Conditional Formatting be sufficient ?

NickHK

"Juuljus" <[email protected]> wrote in message
news:[email protected]...
> 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.

[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" <[email protected]> wrote in message
news:[email protected]...
> Show me what you have in mind.
>

[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

"Juuljus" <[email protected]> wrote in message
news:[email protected]...
> 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,
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 wrote:
> 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.
>

--

Andy Pope, Microsoft MVP - Excel
http://www.andypope.info

[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)


"Juuljus" <[email protected]> wrote in message
news:[email protected]...
> 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
>

[Andy Pope]

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

Cheers
Andy

Bob Phillips wrote:
> 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
>

--

Andy Pope, Microsoft MVP - Excel
http://www.andypope.info

[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


"Andy Pope" <[email protected]> wrote in message
news:[email protected]...
> Thanks Bob. If you default the cell color to Green you can get away with
> only 2 conditions.
>
> Cheers
> Andy
>
> Bob Phillips wrote:
> > 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
> >
>
> --
>
> Andy Pope, Microsoft MVP - Excel
> http://www.andypope.info

[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

[Juuljus]

yep, thats it.

[Ken Johnson]

Hi Juuljus,
Good.
Will it always be just those 21 rows?
Will the string values in column AM be changing? I'm guessing they
will.

Ken Johnson

[Juuljus]

yes the values there are changing. They come from an advance filtering
search. But there are 21 rows, and that value is also the max, usually
there are only 10-14 rows.

[Ken Johnson]

Hi Juuljus,

Do you want the code to be manually run after you click a button or
automatically run by a SheetChange Event procedure?
Do you want me to email the worksheet or just give you the code here?

Ken Johnson

[Juuljus]

the code will be put into a existing sub, that's trigered when clicking
on a button.
paste the code here, so other who are interested can also have an
answer.

Thanks,
Juuljus

[Ken Johnson]

Hi Juuljus,

I'll try to explain the set up I've used then email the workbook.

1. The traffic lights is a group of 21 round autoshapes. I named this
group "Traffic Lights" by first selecting it then typing "Traffic
Lights", without the speech marks, into the Name Box, then pressing
Enter. The Name Box is just to the left of the Formula Bar. If you
select the traffic lights you should see its name in the Name Box. The
code uses this name and will not work if the name is changed. (the name
is lost if the group is ungrouped) If the name does change just change
it back.

2. The main code is in module 1 as a sub procedure called
Control_Lights. Its is a For Next loop that loops through the cells
and lights with a Select Case inside for determining the correct color.

3. Every time a cell on the sheet changes value the
Workbook_SheetChange Sub in the ThisWorkbook Module runs the
Control_Lights code if the cell that changed is in the range AM10:AM30.

Ken Johnson

[Ken Johnson]

Hi Juuljus,
I've emailed the workbook already.
Here is the code:

Public Sub Control_Lights()
Dim TrafficLights As Shape, I As Integer
Set TrafficLights = ActiveSheet.Shapes("Traffic Lights")
For I = 1 To 21
Select Case Cells(I + 9, 39).Value
Case "red"
TrafficLights.GroupItems.Item(I).Fill.ForeColor.SchemeColor = 10
Case "green"
TrafficLights.GroupItems.Item(I).Fill.ForeColor.SchemeColor = 11
Case "yellow"
TrafficLights.GroupItems.Item(I).Fill.ForeColor.SchemeColor = 13
Case Else
TrafficLights.GroupItems.Item(I).Fill.ForeColor.SchemeColor = 9
End Select
Next I
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
If Target.Column <> 39 Then
Exit Sub
End If
If Target.Row < 10 Or Target.Row > 30 Then
Exit Sub
End If
Control_Lights
End Sub


Hope it works out OK

Ken Johnson

[Juuljus]

Nice code Ken, thanks for that.

The problem is, I need do to another advanced filtering on that , and
the lights must go in another sheet into a table. I tried, but it
didn't work. Maybe when done so that all the ovals are separate shapes
it could work.
At the moment I figured out a way with conditional formatting, and it
works. As a deadline is moving, I'm heading forward with another task,
after the project is done, I'll start fine tuning it and then I'll come
back if needed. But as I understand you have personal interest in this
problem, so if you want you can continue working on it.

Again, big thanks to you Ken, and everybody else who participated!

Br,
Juuljus

[Pedro Serra]

Juuljus,

Can u please send me ([email protected]) an workbook with an example
of oval traffic lights?

I simple need that the oval shapes change their colour (yellow, green, red)
according to a value in cell, do u think u can help me on this?

"Juuljus" wrote:

> Nice code Ken, thanks for that.
>
> The problem is, I need do to another advanced filtering on that , and
> the lights must go in another sheet into a table. I tried, but it
> didn't work. Maybe when done so that all the ovals are separate shapes
> it could work.
> At the moment I figured out a way with conditional formatting, and it
> works. As a deadline is moving, I'm heading forward with another task,
> after the project is done, I'll start fine tuning it and then I'll come
> back if needed. But as I understand you have personal interest in this
> problem, so if you want you can continue working on it.
>
> Again, big thanks to you Ken, and everybody else who participated!
>
> Br,
> Juuljus
>
>