Change shape fill color depending on cell value
Hi guys,
(newbie vba)
I've been searching the web for the following issue (I just cannot seem to get it to work):
I've got two shapes in which I want the color to change depending on a drop down list Open/closed.
If valve_1 has status "Open" then that corresponding valve is to be filled with green.
If it is "Closed" it is to be red.
The same for Valve 2.
I have uploaded what I've got so far on the basis of an example I have found online, but it just does not work.
Any help much appreciated.
There was no code in that sample to work... So, simplistic code. You may wish to add extra checks to determine if just the dropdown changes.
Private Sub Worksheet_Change(ByVal Target As Range) Shapes(3).Fill.ForeColor.RGB = IIf(StrConv(Range("l9").Value, vbUpperCase) = "OPEN", RGB(43, 170, 26), RGB(255, 0, 0)) Shapes(5).Fill.ForeColor.RGB = IIf(StrConv(Range("l10").Value, vbUpperCase) = "OPEN", RGB(43, 170, 26), RGB(255, 0, 0)) End Sub
reference to cytop answer:
Awesome, it works, one thing though.
How did you know to put "3" and "5" as the reference to those shapes? When I select them, "valve_1" and "valve_2" appear.
I've added a new third valve, but how do I find the shape name to put in to the code?
Update: just since his code was more simple
Last edited by xe-dingo; 08-30-2013 at 07:52 AM.
there was code, although incorrect, in the thisworkbook object.
moved to the sheet object and using the change event
the code you had will workPrivate Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range Dim ShapeName As String Dim SHP As Shape ShapeName = "Valve_1" Set Rng = ThisWorkbook.Worksheets("Sheet1").Range("L9") Set SHP = Rng.Parent.Shapes(ShapeName) If Rng.Value = "OPEN" Then SHP.Fill.ForeColor.RGB = RGB(0, 255, 0) ' green Else SHP.Fill.ForeColor.RGB = RGB(255, 0, 0) End If ShapeName = "Valve_2" Set Rng = ThisWorkbook.Worksheets("Sheet1").Range("L10") Set SHP = Rng.Parent.Shapes(ShapeName) If Rng.Value = "OPEN" Then SHP.Fill.ForeColor.RGB = RGB(0, 255, 0) ' green Else SHP.Fill.ForeColor.RGB = RGB(255, 0, 0) End If End Sub
Alternative using a UDF
code in standard code module
in a cell use formulaPublic Function udfVALVECOLOR(Name As String, Color As Long) On Error Resume Next ActiveSheet.Shapes(Name).Fill.ForeColor.RGB = Color Exit Function End Function
=udfVALVECOLOR("Valve_1",IF(L9="OPEN",65280,255))
65280 is RGB(0,255,0)
So there is - I double clicked on the ThisWorkBook module for another workbook - Duh!there was code...
As far as the shape names go, you can simply useI just hacked some code together quickly after assuming there was none...Shapes("valve_1").Fill.ForeColor...
Hi guys,
Thanks so much for the help.
At the moment I am using the following code which is working perfectly:
Only thing is, that I would now like to have three color options instead of just two. OPEN=Green, CLOSED=Red and NA=White.Private Sub Worksheet_Change(ByVal Target As Range) Shapes("Valve_20").Fill.ForeColor.RGB = IIf(StrConv(Range("DF53").Value, vbUpperCase) = "OPEN", RGB(43, 170, 26), RGB(255, 0, 0)) Shapes("Valve_30").Fill.ForeColor.RGB = IIf(StrConv(Range("DF54").Value, vbUpperCase) = "OPEN", RGB(43, 170, 26), RGB(255, 0, 0)) Shapes("Valve_10").Fill.ForeColor.RGB = IIf(StrConv(Range("DF55").Value, vbUpperCase) = "OPEN", RGB(43, 170, 26), RGB(255, 0, 0)) End Sub
How can this be incorporated in to the code? any help MUCH appreciated.
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks