Making "traffic lights"

[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

 

[Guest]

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?