• Skip to main content
  • Skip to header right navigation
  • Skip to site footer

My Online Training Hub

Learn Dashboards, Excel, Power BI, Power Query, Power Pivot

  • Courses
  • Pricing
    • Free Courses
    • Power BI Course
    • Excel Power Query Course
    • Power Pivot and DAX Course
    • Excel Dashboard Course
    • Excel PivotTable Course – Quick Start
    • Advanced Excel Formulas Course
    • Excel Expert Advanced Excel Training
    • Excel Tables Course
    • Excel, Word, Outlook
    • Financial Modelling Course
    • Excel PivotTable Course
    • Excel for Customer Service Professionals
    • Excel for Operations Management Course
    • Excel for Decision Making Under Uncertainty Course
    • Excel for Finance Course
    • Excel Analysis ToolPak Course
    • Multi-User Pricing
  • Resources
    • Free Downloads
    • Excel Functions Explained
    • Excel Formulas
    • Excel Add-ins
    • IF Function
      • Excel IF Statement Explained
      • Excel IF AND OR Functions
      • IF Formula Builder
    • Time & Dates in Excel
      • Excel Date & Time
      • Calculating Time in Excel
      • Excel Time Calculation Tricks
      • Excel Date and Time Formatting
    • Excel Keyboard Shortcuts
    • Excel Custom Number Format Guide
    • Pivot Tables Guide
    • VLOOKUP Guide
    • ALT Codes
    • Excel VBA & Macros
    • Excel User Forms
    • VBA String Functions
  • Members
    • Login
    • Password Reset
  • Blog
  • Excel Webinars
  • Excel Forum
    • Register as Forum Member

Change shape color based on another cell value|VBA & Macros|Excel Forum|My Online Training Hub

You are here: Home / Change shape color based on another cell value|VBA & Macros|Excel Forum|My Online Training Hub
Avatar
sp_LogInOut Log In sp_Registration Register
sp_Search Search
Advanced Search|Last Search Results
Search
Forum Scope




Match



Forum Options



Minimum search word length is 3 characters - maximum search word length is 84 characters
sp_Search Search
sp_RankInfo
Lost password?
sp_CrumbsHome HomeExcel ForumVBA & MacrosChange shape color based on another…
sp_PrintTopic sp_TopicIcon
Change shape color based on another cell value
Avatar
Riste Chaushev
Macedonia
Member
Members
Level 0
Forum Posts: 22
Member Since:
June 22, 2020
sp_UserOfflineSmall Offline
1
December 25, 2020 - 8:32 pm
sp_Permalink sp_Print

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

Avatar
Lionel Baijot
Member
Members
Level 0
Forum Posts: 114
Member Since:
September 9, 2020
sp_UserOfflineSmall Offline
2
December 26, 2020 - 12:36 am
sp_Permalink sp_Print

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
Avatar
Riste Chaushev
Macedonia
Member
Members
Level 0
Forum Posts: 22
Member Since:
June 22, 2020
sp_UserOfflineSmall Offline
3
December 26, 2020 - 1:06 am
sp_Permalink sp_Print

Thank you!

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

How can I continue the code?

Avatar
Lionel Baijot
Member
Members
Level 0
Forum Posts: 114
Member Since:
September 9, 2020
sp_UserOfflineSmall Offline
4
December 26, 2020 - 1:28 am
sp_Permalink sp_Print sp_EditHistory

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
Avatar
Lionel Baijot
Member
Members
Level 0
Forum Posts: 114
Member Since:
September 9, 2020
sp_UserOfflineSmall Offline
5
December 26, 2020 - 7:02 pm
sp_Permalink sp_Print sp_EditHistory

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
Avatar
Riste Chaushev
Macedonia
Member
Members
Level 0
Forum Posts: 22
Member Since:
June 22, 2020
sp_UserOfflineSmall Offline
6
December 28, 2020 - 11:07 pm
sp_Permalink sp_Print

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.

Avatar
Lionel Baijot
Member
Members
Level 0
Forum Posts: 114
Member Since:
September 9, 2020
sp_UserOfflineSmall Offline
7
January 1, 2021 - 12:33 am
sp_Permalink sp_Print

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

Avatar
Riste Chaushev
Macedonia
Member
Members
Level 0
Forum Posts: 22
Member Since:
June 22, 2020
sp_UserOfflineSmall Offline
8
January 21, 2021 - 7:24 pm
sp_Permalink sp_Print

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.Error1.PNGImage Enlarger

Error2.PNGImage Enlarger

sp_PlupAttachments Attachments
  • sp_PlupImage Error1.PNG (194 KB)
  • sp_PlupImage Error2.PNG (10 KB)
Avatar
Lionel Baijot
Member
Members
Level 0
Forum Posts: 114
Member Since:
September 9, 2020
sp_UserOfflineSmall Offline
9
January 22, 2021 - 3:09 pm
sp_Permalink sp_Print

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

Avatar
Riste Chaushev
Macedonia
Member
Members
Level 0
Forum Posts: 22
Member Since:
June 22, 2020
sp_UserOfflineSmall Offline
10
January 22, 2021 - 6:04 pm
sp_Permalink sp_Print

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.

Avatar
Lionel Baijot
Member
Members
Level 0
Forum Posts: 114
Member Since:
September 9, 2020
sp_UserOfflineSmall Offline
11
January 22, 2021 - 11:35 pm
sp_Permalink sp_Print sp_EditHistory

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

Image-5.pngImage Enlarger

 

DASHBOARD sheet

  1. Name each rectangle in accordance with the structure

RECT_USCHALL_VK_01

 

Image-6.pngImage Enlarger

 

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

sp_PlupAttachments Attachments
  • sp_PlupImage Image-5.png (122 KB)
  • sp_PlupImage Image-6.png (261 KB)
Avatar
Velouria
London or thereabouts
Moderator
Members


Trusted Members

Moderators
Level 4
Forum Posts: 617
Member Since:
November 1, 2018
sp_UserOfflineSmall Offline
12
January 23, 2021 - 1:17 am
sp_Permalink sp_Print

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.

Avatar
Riste Chaushev
Macedonia
Member
Members
Level 0
Forum Posts: 22
Member Since:
June 22, 2020
sp_UserOfflineSmall Offline
13
January 24, 2021 - 10:39 pm
sp_Permalink sp_Print

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.

Problem1.PNGImage Enlarger

Problem2.PNGImage Enlarger

sp_PlupAttachments Attachments
  • sp_PlupImage Problem1.PNG (138 KB)
  • sp_PlupImage Problem2.PNG (84 KB)
Avatar
Velouria
London or thereabouts
Moderator
Members


Trusted Members

Moderators
Level 4
Forum Posts: 617
Member Since:
November 1, 2018
sp_UserOfflineSmall Offline
14
January 25, 2021 - 7:54 pm
sp_Permalink sp_Print

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

Avatar
Riste Chaushev
Macedonia
Member
Members
Level 0
Forum Posts: 22
Member Since:
June 22, 2020
sp_UserOfflineSmall Offline
15
January 25, 2021 - 10:32 pm
sp_Permalink sp_Print

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.Capture.PNGImage Enlarger

sp_PlupAttachments Attachments
  • sp_PlupImage Capture.PNG (351 KB)
Avatar
Velouria
London or thereabouts
Moderator
Members


Trusted Members

Moderators
Level 4
Forum Posts: 617
Member Since:
November 1, 2018
sp_UserOfflineSmall Offline
16
January 26, 2021 - 8:01 pm
sp_Permalink sp_Print

The formula goes in a cell, not in the shape.

Avatar
Riste Chaushev
Macedonia
Member
Members
Level 0
Forum Posts: 22
Member Since:
June 22, 2020
sp_UserOfflineSmall Offline
17
January 26, 2021 - 11:02 pm
sp_Permalink sp_Print

Hi Velouria, 

Thank you very much.

This was very simple, yet effective solution. 

Now it works!

 

Thank you again.

 

Best Regards,

Riste.

sp_Feed
Go to top
Forum Timezone: Australia/Brisbane
Most Users Ever Online: 245
Currently Online: Ahmad Alkhuffash, Chandler Davis
Guest(s) 9
Top Posters:
SunnyKow: 1432
Anders Sehlstedt: 870
Purfleet: 412
Frans Visser: 346
David_Ng: 306
lea cohen: 219
A.Maurizio: 202
Jessica Stewart: 202
Aye Mu: 201
jaryszek: 183
Newest Members:
michael serna
mashal sana
Tiffany Kang
Leah Gillmore
Sopi Yuniarti
LAFONSO HERNANDEZ
Hayden Hao
Angela chen
Sean Moore
John Chisholm
Forum Stats:
Groups: 3
Forums: 24
Topics: 6215
Posts: 27245

 

Member Stats:
Guest Posters: 49
Members: 31897
Moderators: 3
Admins: 4
Administrators: Mynda Treacy, Philip Treacy, Catalin Bombea, FT
Moderators: MOTH Support, Velouria, Riny van Eekelen
© Simple:Press —sp_Information

Sidebar

Blog Categories

  • Excel
  • Excel Charts
  • Excel Dashboard
  • Excel Formulas
  • Excel PivotTables
  • Excel Shortcuts
  • Excel VBA
  • General Tips
  • Online Training
  • Outlook
  • Power Apps
  • Power Automate
  • Power BI
  • Power Pivot
  • Power Query
microsoft mvp logo
trustpilot excellent rating
Secured by Sucuri Badge
MyOnlineTrainingHub on YouTube Mynda Treacy on Linked In Mynda Treacy on Instagram Mynda Treacy on Twitter Mynda Treacy on Pinterest MyOnlineTrainingHub on Facebook
 

Company

  • About My Online Training Hub
  • Disclosure Statement
  • Frequently Asked Questions
  • Guarantee
  • Privacy Policy
  • Terms & Conditions
  • Testimonials
  • Become an Affiliate

Support

  • Contact
  • Forum
  • Helpdesk - For Technical Issues

Copyright © 2023 · My Online Training Hub · All Rights Reserved. Microsoft and the Microsoft Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries. Product names, logos, brands, and other trademarks featured or referred to within this website are the property of their respective trademark holders.