Log In
Register
Home
June 22, 2020
Offline
Hello,
I have an issue about changing shape's color based on another cell value. If the value is below 50, I want it to be changed to RGB(255, 140, 140).
I have tried with VBA with multiple codes, and I don't know why it doesn't work, as there is no bug showing.
I have power query in another sheet, but I am taking the values with "=" to the main sheet so I don't complicate the code, but still, no effect.
Can someone please help?
Here is the code that I have:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("H2")) Is Nothing Then Exit Sub
If IsNumeric(Target.Value) Then
If Target.Value < 50 Then
ActiveSheet.Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = vbRed
ElseIf Target.Value >= 51 And Target.Value < 100 Then
ActiveSheet.Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = vbYellow
Else
ActiveSheet.Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = vbGreen
End If
End If
End Sub
September 9, 2020
Offline
Hello Riste Chaushev,
It is not a Change but a Calculate that must be used.
Test with this :
Private Sub Worksheet_Calculate()
Dim target As Range
Set target = Range("H2")
If Not Intersect(target, Range("H2")) Is Nothing Then
If target.Value < 50 Then
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = vbRed
ElseIf target.Value >= 51 And target.Value < 100 Then
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = vbYellow
Else
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = vbGreen
End If
End If
End Sub
June 22, 2020
Offline
Thank you!
And what if I have 20 shapes in the same sheet?
How can I continue the code?
September 9, 2020
Offline
Re-Hi Riste Chaushev,
To use the RGB code, do the following:
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = RGB(255, 140, 140)
Private Sub Worksheet_Calculate()
Dim target As Range
Set target = Range("H2")
If Not Intersect(target, Range("H2")) Is Nothing Then
If target.Value < 50 Then
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = RGB(255, 55, 15)
ElseIf target.Value >= 51 And target.Value < 100 Then
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = RGB(248, 255, 31)
Else
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = RGB(13, 255, 37)
End If
End If
End Sub
BR, Lionel
September 9, 2020
Offline
Hi,
You ask the question with 20 shapes. OK. But there are not enough elements to answer you. What do you want to do with these 20 shapes? Will it be the same treatment that is applied to the 20 shapes? Then you make a simple loop like this (see the new version of your file with 5 shapes) :
Private Sub Worksheet_Calculate()
Dim i As Integer
Dim target As Range
Set target = Range("H2")
If Not Intersect(target, Range("H2")) Is Nothing Then
For i = 1 To 5
If target.Value < 50 Then
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners " & i).Fill.ForeColor.RGB = RGB(255, 55, 15)
ElseIf target.Value >= 51 And target.Value < 100 Then
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners " & i).Fill.ForeColor.RGB = RGB(248, 255, 31)
Else
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners " & i).Fill.ForeColor.RGB = RGB(13, 255, 37)
End If
Next i
End If
End Sub
BR,
Lionel
June 22, 2020
Offline
Hi,
First of all, thank you Lionel.
Second, I am sorry that I didn't provide all the facts about it.
So, here they are: I am making a dashboard, that gets the data from another source with power query, and I am getting that data in my main sheet which is named "Dashboard".
The data in my original file is starting from cell AA2, the same as in the file that is attached.
I have 54 shapes, each named with a specific name as you can see. All the shapes to have the same treatment with the value and the color.
The main idea and the goal is that, if some value falls down to 50 or below, the shape to have the color RGB(255, 140, 140). Instead, to have RGB(222, 215, 215).
So, could you please help me with the code for all 54 shapes?
Thank you.
September 9, 2020
Offline
Re-Hi,
I haven't understood everything yet, but I think I'm getting closer to the truth: in Sheet2, you do your encoding. Then, this encoding is reflected in the Dashboard sheet where your shapes are?
Me, instead of working on Dashboard, I work on Test1. What have I done?
1. In Sheet2, I named the A2 cells → I2.
2. In Test1 I gave the shapes the same name. It was like this: Cell A2 (from Sheet2) is called C_1 and the shape that corresponds to the value of cell A2 is called Rectangle: C_1.
3. Next, simply retrieve the modified cell, compare its value and colour the corresponding shape.
BR,
Lionel
June 22, 2020
Offline
Hello Lionel,
I can't get to make it work. I renamed the cells in my original file just like yours, C_1, and the shapes in the sheet "Dashboard" just like yours in Sheet2 - Rectangle : C_1 etc. But, when the numbers change the color in my file for the shapes is not working.
And I am getting an error(pls see the picture attached).
Could you please see and help?
Thank you.
September 9, 2020
Offline
Hi Riste Chaushev,
As I don't know how you modified the file, it is difficult to answer with certainty.
Can you share part of your file as modified and without personal data?
BR,
Lionel
June 22, 2020
Offline
Hello Lionel,
Attached you can find my dashboard with modified data.
The main sheet is "Dashboard" and as you will see, all the data in the shapes is taken from the other sheets respectively.
Could you try on this file?
Thank you.
September 9, 2020
Offline
Hi Riste Chaushev,
Here are the steps (and the file) for only USCHALL sheet.
USCHALL sheet
- Do not use a structured table
- Name the cells A2 → J2 respecting the structure
A2 → USCHALL_VK_01
B2 → USCHALL_VK_02
...
DASHBOARD sheet
- Name each rectangle in accordance with the structure
RECT_USCHALL_VK_01
Macro
- Place the code at the level of each sheet. The code is used to detect changes that are made in the sheet and not in the whole file.
BR,
Lionel
Trusted Members
Moderators
November 1, 2018
Offline
You could also do this with a UDF:
Function ColourShape(theValue As Double, ShapeName As String)
With Application.Caller.Worksheet.Shapes(ShapeName)
If theValue <= 50 Then
.Fill.ForeColor.RGB = RGB(255, 140, 140)
Else
.Fill.ForeColor.RGB = RGB(222, 215, 215)
End If
End With
ColourShape = ""
End Function
then in your sheet, you'd just need a formula cell for each shape using a formula like:
=ColourShape(AA2,"CR.01")
where cell AA2 contains the value you want to monitor for shape CR.01 and so on.
June 22, 2020
Offline
Hello to both,
I don't know what the problem is, but I just can't get it to work..
@Lionel - I tried exactly the same way as yours, but when I work on your file, the color is changing, but when I try to implement exactly the same solution to my file it's not working. I've renamed the shapes exactly the same way, I've named all the cells in all tables exactly like your example and it's not working. Maybe it's because it's taking the data with power query and it's tables? I've also tried to take the data out of the power query tables, I've changed the range to be outside of the power query tables in my new cells with the same data and still, nothing...it gives me an error (see pictures attached)
Could you please see and lookout further what could be the problem?
@Velouria - I tried with your example code, but still - no result. I am writing the code for the formula, but when I want to implement the formula in the shape, after "=" it doesn't give me ColourShape formula.
Trusted Members
Moderators
November 1, 2018
Offline
The function code must be in a normal module, not a worksheet or ThisWorkbook module.
June 22, 2020
Offline
Hello Velouria,
I tried with normal module and the formula works.
But when I implement the formula in the shape that I want to change the color, it gives me this error.
Any solution?
Thank you.
