 |
 | Home | Contact Us | FAQ | Search & Site Map | Link to Us |
 | Sign In | Join | Other 45 Sites in Network |
| HomeDiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWordDirectoryUser Groups Related Topics Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ... |
MS Office Forum / Excel / Programming / February 2006Making "traffic lights"
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, Would Conditional Formatting be sufficient ? NickHK > Hi, > [quoted text clipped - 6 lines] > But I can't code it. > The light indicator should be next to the cell that has the value. Show me what you have in mind. That would be cells, not ovals, and just test the cell value within the conditional formatting. Check CF in help.  SignatureHTH RP (remove nothere from the email address if mailing direct) > Show me what you have in mind. I knew that. Colorful cell would look ugly. I need ovals. 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 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 > OK, what will change the string "yellow" to shape named "yellow"? > [quoted text clipped - 9 lines] > End If > End With If you can figure out a way to show shapes that way then yes. 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 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 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 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 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 > Hi, > [quoted text clipped - 6 lines] > But I can't code it. > The light indicator should be next to the cell that has the value. SignatureAndy Pope, Microsoft MVP - Excel http://www.andypope.info 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 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 SignatureHTH RP (remove nothere from the email address if mailing direct) > Good idea Andy. > [quoted text clipped - 3 lines] > > Juuljus Thanks Bob. If you default the cell color to Green you can get away with only 2 conditions. Cheers Andy > Select the traffic lights, but where the cells with yello, green, red let's > say start at A1 [quoted text clipped - 29 lines] > OK > OK SignatureAndy Pope, Microsoft MVP - Excel http://www.andypope.info 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 > Thanks Bob. If you default the cell color to Green you can get away with > only 2 conditions. [quoted text clipped - 35 lines] > > OK > > OK 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 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 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 yep, thats it. 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 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. 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 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 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 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 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 Juuljus, Can u please send me (pedrofilipeserra@clix.pt) 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? > Nice code Ken, thanks for that. > [quoted text clipped - 12 lines] > Br, > Juuljus |
Reply to this Message |
 Sign In
 Join
 My Latest Posts My Monitored Threads My Blog My Photo Gallery My Profile My Homepage Start New Thread Enable EMail Alerts Rate this Thread
|
©2008 Advenet LLC Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.