Want to create some dynamic dashboard in which the shapes will alter color as the reference cell's value would change (based on some threshold value).
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("M5")) Is Nothing Then Exit Sub
If IsNumeric(Target.Value) Then
If Target.Value < Range("$AA$5") Then
ActiveSheet.Shapes("Isosceles Triangle 3").Fill.ForeColor.RGB = vbRed
ElseIf Target.Value >= Range("$AA$5") And Target.Value < Range("$Y$5") Then
ActiveSheet.Shapes("Isosceles Triangle 3").Fill.ForeColor.RGB = vbYellow
ElseIf Target.Value >= Range("$Y$5") And Target.Value < Range("$Z$5") Then
ActiveSheet.Shapes("Isosceles Triangle 3").Fill.ForeColor.RGB = vbGreen
ElseIf Target.Value >= Range("$Z$5") And Target.Value < Range("$AB$5") Then
ActiveSheet.Shapes("Isosceles Triangle 3").Fill.ForeColor.RGB = vbYellow
Else
ActiveSheet.Shapes("Isosceles Triangle 3").Fill.ForeColor.RGB = vbRed
End If
End If
End Sub
This is working fine for one Triangle in the Dashboard with some defined threshold value (changing color dynamically). Want replicate the same operation with other triangles as well. How that can be done?
[![The sequence of Triangles][1]][1]
Edited & Added part:
The dashboard has multiple Brand wise performance to showcase.
The schematic diagram:[enter image description here][2]
The Actual data across brands at CFA, DB & SS level : Actual Data [enter image description here][3]
The threshold level across CFA, SS & Sub D: [enter image description here][4]
So for every brand (Brand 1,2 &3) at stocking points (CFA,DB & SS level), the color code behave like:
If the actual< UCL2, the triangle will be red (e.g. Brand1 at CFA is 9, respective tringle will be red), UCL2<= actual Yellow , UCL1<= actual Green , LCL1<= actual Yellow , Actual =>LCL2 --> Red
Hope now the problem is much more crystal. Anticipating assistance regarding this...TIA
EDITED on your request
and sligthly refactored
Private Sub Worksheet_Change(ByVal Target As Range)
Colorize ActiveSheet.Shapes("Isosceles Triangle 1"), Target, Range, ("M1"), Range("$AA$5").Value, Range("$AB$5").Value, Range("$Y$5").Value, Range("$Z$5").Value
Colorize ActiveSheet.Shapes("Isosceles Triangle 2"), Target, Range("M3"), 19, 60, 32, 38
'Colorize ActiveSheet.Shapes("Isosceles Triangle 3"), Target, Range("M5")
End Sub
Private Sub Colorize(shp As Shape, ByVal Target As Range, rValue as Range, _
YellowLow As long, YellowHigh As Long, _
GreenLow As Long, GreenHigh As Long)
Dim iColor As Long
If Intersect(Target, rValue) Is Nothing Then Exit Sub
'If IsNumeric(Target.Value) Then
' iColor = vbRed
' If Target.Value < Range("$AA$5") Then
' iColor = vbRed
' ElseIf Target.Value >= Range("$AA$5") And Target.Value < Range("$Y$5") Then
' iColor = vbYellow
' ElseIf Target.Value >= Range("$Y$5") And Target.Value < Range("$Z$5") Then
' iColor = vbGreen
' ElseIf Target.Value >= Range("$Z$5") And Target.Value < Range("$AB$5") Then
' iColor = vbYellow
' End If
If IsNumeric(Target.Value) Then
iColor = vbRed
If Target.Value >= YellowLow And Target.Value <= YellowHigh Then iColor = vbYellow
If Target.Value >= GreenLow And Target.Value <= GreenHigh Then iColor = vbGreen
shp.Fill.ForeColor.RGB = iColor
End If
End Sub
Collected from the Internet
Please contact [email protected] to delete if infringement.
Comments