change shape colour based on cell value

sainil

New Member
Joined
Oct 28, 2013
Messages
35
I have some shapes like pupms, compressors etc on an excel sheet. How the colour of these shapes can be changed either red or greeen based on the cell values in another sheet of the same work book. If the cell value is +1 need green colour and and if -1 need red colour. I have excel 2013.
 

Some videos you may like

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

Momentman

Well-known Member
Joined
Jan 11, 2012
Messages
4,066
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Here is an example which you have to tweak to fit your sheet names, shapes and ranges
Code:
Private Sub Worksheet_Calculate()
    With ActiveSheet.Shapes.Range(Array("Oval 2"))
        Select Case Range("A1").Value
             Case -1
                 .Fill.ForeColor.RGB = RGB(255, 0, 0)
             Case 1
                 .Fill.ForeColor.RGB = RGB(0, 255, 0)
             Case Else
                .Fill.ForeColor.RGB = RGB(255, 255, 255)
         End Select
     End With
End Sub

You right click the sheet that has the shapes and select View code, then paste the above code in there
 

sainil

New Member
Joined
Oct 28, 2013
Messages
35
Yes, it is working nice, thanks.
But I have more shapes, say around 50 nos in one work sheet. So how the code can be changed?
 

Momentman

Well-known Member
Joined
Jan 11, 2012
Messages
4,066
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
This should loop through all the shapes in the worksheet and changes all the colours
Code:
Private Sub Worksheet_Calculate()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        With ActiveSheet.Shapes.Range(Array(shp.Name))
            Select Case Range("A1").Value
                 Case -1
                     .Fill.ForeColor.RGB = RGB(255, 0, 0)
                 Case 1
                     .Fill.ForeColor.RGB = RGB(0, 255, 0)
                 Case Else
                    .Fill.ForeColor.RGB = RGB(255, 255, 255)
             End Select
         End With
     Next shp
End Sub
 

sainil

New Member
Joined
Oct 28, 2013
Messages
35

ADVERTISEMENT

Sorry, I think my explonation was not clear.

I have cell values like A1 has 1, A2 has -1, A3 -1, A4 has 1 and so on like in random order and each cell is assigned to a particular shape. eg: cell A1 assigned to shape "group 1" cell A2 assigned to shape "group 2" and so on. Cell value changes as the equipment is in running or in stop condition. Requirement is, as the cell value changes, the colour of the shape assigned to that particular cell should change.

I think now it is more clear. Please help.
 

Momentman

Well-known Member
Joined
Jan 11, 2012
Messages
4,066
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
OK,

Where do you have the mapping? as in something that shows which shape is linked to what cell?
 

sainil

New Member
Joined
Oct 28, 2013
Messages
35

ADVERTISEMENT

thanks for the support.

I have cells from A1 to A100( say 100 cells) and cell A1 is linked to shape "Group 1" and cell A2 to shape "Group 2" and so on last cell A100 to shape "Group 100"
Is it possible to make a code for this?

thanks
 

Momentman

Well-known Member
Joined
Jan 11, 2012
Messages
4,066
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
That would be something like this
Code:
Private Sub Worksheet_Calculate()
    Dim shp As Shape, I As Integer
    For I = 1 To 100
        With ActiveSheet.Shapes.Range(Array("Group " & I))
            Select Case Range("A" & I).Value
                 Case -1
                     .Fill.ForeColor.RGB = RGB(255, 0, 0)
                 Case 1
                     .Fill.ForeColor.RGB = RGB(0, 255, 0)
                 Case Else
                    .Fill.ForeColor.RGB = RGB(255, 255, 255)
             End Select
         End With
     Next I
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,494
Messages
5,596,486
Members
414,070
Latest member
DuncanLucas

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top