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

Thank you!

And what if I have 20 shapes in the same sheet?

How can I continue the code?

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

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

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.

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

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.

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

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.

Hi Riste Chaushev,

Here are the steps (and the file) for only USCHALL sheet.

USCHALL sheet

1. Do not use a structured table
2. Name the cells A2 → J2 respecting the structure

A2 → USCHALL_VK_01
B2 → USCHALL_VK_02
...

DASHBOARD sheet

1. Name each rectangle in accordance with the structure

RECT_USCHALL_VK_01

Macro

1. 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

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.

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.

The function code must be in a normal module, not a worksheet or ThisWorkbook module.

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.