VBA to change the text colour in a shape

cjcass

Well-known Member
Joined
Oct 27, 2011
Messages
577
Office Version
  1. 2016
Platform
  1. Windows
Hi, I have entered some VBA (by right clicking the wksheet tab) to change the fill colour of a shape based on a cell value, as follows...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$8" Then
Select Case Target.Value
Case Is = "Full"
ActiveSheet.Shapes("Rectangle 1").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 118, 115)
End Select
End If


Q: What script would I need to type into this to also change the colour of the text in Rectangle 1, to say RGB(255, 255, 255)..?

Many thanks,
Chris
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,149
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Hi, I have entered some VBA (by right clicking the wksheet tab) to change the fill colour of a shape based on a cell value, as follows...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$8" Then
Select Case Target.Value
Case Is = "Full"
ActiveSheet.Shapes("Rectangle 1").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 118, 115)
End Select
End If


Q: What script would I need to type into this to also change the colour of the text in Rectangle 1, to say RGB(255, 255, 255)..?

Many thanks,
Chris
This is how I would write your change event code...

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$E$8" Then
    Select Case Target.Value
    Case Is = "Full"
      With ActiveSheet.Shapes("Rectangle 1")
        .Fill.ForeColor.RGB = RGB(0, 118, 115)
        .TextFrame.Characters.Font.Color = RGB(255, 255, 255)
      End With
    End Select
  End If
End Sub
 

cjcass

Well-known Member
Joined
Oct 27, 2011
Messages
577
Office Version
  1. 2016
Platform
  1. Windows
This is how I would write your change event code...

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$E$8" Then
    Select Case Target.Value
    Case Is = "Full"
      With ActiveSheet.Shapes("Rectangle 1")
        .Fill.ForeColor.RGB = RGB(0, 118, 115)
        .TextFrame.Characters.Font.Color = RGB(255, 255, 255)
      End With
    End Select
  End If
End Sub

Thanks Rick works great...

now I have encountered another problem - the vba doesn't automatically update when the contents of cell E8 change - how could I achieve this?

I know that I can select E8, put the cursor in it and press return to activate the change, but I will eventually want to extend this code to be calculating about 30 cells, colouring 30 shapes - any ideas?

Best Rgds,
Chris
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,149
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Thanks Rick works great...

now I have encountered another problem - the vba doesn't automatically update when the contents of cell E8 change - how could I achieve this?

I know that I can select E8, put the cursor in it and press return to activate the change, but I will eventually want to extend this code to be calculating about 30 cells, colouring 30 shapes - any ideas?
Sorry, I forgot this was event code and you would want the colors to revert to black and white if cell E8 did not contain "Full". Try this modified version of my code...

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$E$8" Then
    Select Case Target.Value
    Case Is = "Full"
      With ActiveSheet.Shapes("Rectangle 2")
        .Fill.ForeColor.RGB = RGB(0, 118, 115)
        .TextFrame.Characters.Font.Color = RGB(255, 255, 255)
      End With
    Case Else
      With ActiveSheet.Shapes("Rectangle 2")
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .TextFrame.Characters.Font.Color = 0
      End With
    End Select
  End If
End Sub
 

cjcass

Well-known Member
Joined
Oct 27, 2011
Messages
577
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Sorry but I may have not explained the issue clearly...

When I populate E8 with a different word, say "Empty", I have some code in the same format above that will change the shape to a different colour and the code works, but the code won't activate or detect the change in E8 unless I select the cell and press return - hope this makes more sense...

Rgds,
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,149
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Sorry but I may have not explained the issue clearly...

When I populate E8 with a different word, say "Empty", I have some code in the same format above that will change the shape to a different colour and the code works, but the code won't activate or detect the change in E8 unless I select the cell and press return - hope this makes more sense...

Are you looking for something like this (where you would continue to add Case statements for each word in E8 that you wanted to monitor?

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$E$8" Then
    Select Case Target.Value
    Case Is = "Full"
      With ActiveSheet.Shapes("Rectangle 1")
        .Fill.ForeColor.RGB = RGB(0, 118, 115)
        .TextFrame.Characters.Font.Color = RGB(255, 255, 255)
      End With
    Case Is = "Empty"
      With ActiveSheet.Shapes("Rectangle 1")
        .Fill.ForeColor.RGB = {{Empty Fill Color}}
        .TextFrame.Characters.Font.Color = {{Empty Font Color}}
      End With
    Case Is = {{some other monitored word}}
      With ActiveSheet.Shapes("Rectangle 1")
        .Fill.ForeColor.RGB = {{Other Monitored Word's Fill Color}}
        .TextFrame.Characters.Font.Color = {{Other Monitored Word's Font Color}}
      End With
    Case etc.....
    Case etc.....
    Case Else
      With ActiveSheet.Shapes("Rectangle 1")
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .TextFrame.Characters.Font.Color = 0
      End With
    End Select
  End If
End Sub
I am not sure I follow what you mean by the section I highlighted in red though... that is the way the Change event works... put a value in the cell and it reacts to it. If you are not entering your data manually into cell E8, how are the words "Full", "Empty", etc. getting into it?
 

cjcass

Well-known Member
Joined
Oct 27, 2011
Messages
577
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Yes, you're absolutely right in terms of what I am looking to achieve - code with varying case statements that change the colour of the rectangle and it's text, based on the word in cell E8...

Regarding the activation of the change event - the word in cell E8 is currently being pasted in, my other option is a formula reading from another worksheet to obtain the word - I have tried both methods of populating E8 and neither activate the change event...

Rgds,
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,149
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Yes, you're absolutely right in terms of what I am looking to achieve - code with varying case statements that change the colour of the rectangle and it's text, based on the word in cell E8...

Regarding the activation of the change event - the word in cell E8 is currently being pasted in, my other option is a formula reading from another worksheet to obtain the word - I have tried both methods of populating E8 and neither activate the change event...
If you used a formula in cell E8, the code would have to be changed to look at the cells the formula refers to (as those are what Excel considers as changing, not the formula that calculate its value from those changes. However, when I paste the work Full or Empty into cell E8, my Change event code reacts immediately to it here in my test workbook. The code as written, is looking for "Full" and "Empty" to have that exact letter casing, so if you type or paste "full" or "empty" into cell E8, it will not meet the criteria of the Case statements... is that what is happening? Another possibility with copy/pasting is that you might end up grabbing a trailing (or even leading) space along with the text... again, that extra character would make the cell value not meet the Case statement... could that be the problem? If either of these problems is what is occurring, I can modify the code to account for them... just let me know.
 

cjcass

Well-known Member
Joined
Oct 27, 2011
Messages
577
Office Version
  1. 2016
Platform
  1. Windows
The characters & case are an exact match so it's not that...

Here's what I have so far...

Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Address = "$E$8" Then
Select Case Target.Value
Case Is = "Full"
With ActiveSheet.Shapes("Rectangle 1")
.Fill.ForeColor.RGB = RGB(0, 118, 115)
.TextFrame.Characters.Font.Color = RGB(255, 255, 255)
End With
Case Is = "Empty"
With ActiveSheet.Shapes("Rectangle 1")
.Fill.ForeColor.RGB = RGB(0, 158, 154)
.TextFrame.Characters.Font.Color = RGB(255, 255, 255)
End With
Case Is = "Quarter"
With ActiveSheet.Shapes("Rectangle 1")
.Fill.ForeColor.RGB = RGB(127, 127, 127)
.TextFrame.Characters.Font.Color = RGB(255, 255, 255)
End With
Case Is = "Half"
With ActiveSheet.Shapes("Rectangle 1")
.Fill.ForeColor.RGB = RGB(138, 0, 0)
.TextFrame.Characters.Font.Color = RGB(255, 255, 255)
End With
Case Is = "NA"
With ActiveSheet.Shapes("Rectangle 1")
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.TextFrame.Characters.Font.Color = RGB(166, 166, 166)
End With
End Select
End If


If Target.Address = "$F$8" Then
Select Case Target.Value
Case Is = "Full"
With ActiveSheet.Shapes("Rectangle 5")
.Fill.ForeColor.RGB = RGB(0, 118, 115)
.TextFrame.Characters.Font.Color = RGB(255, 255, 255)
End With
Case Is = "Empty"
With ActiveSheet.Shapes("Rectangle 5")
.Fill.ForeColor.RGB = RGB(0, 158, 154)
.TextFrame.Characters.Font.Color = RGB(255, 255, 255)
End With
Case Is = "Quarter"
With ActiveSheet.Shapes("Rectangle 5")
.Fill.ForeColor.RGB = RGB(127, 127, 127)
.TextFrame.Characters.Font.Color = RGB(255, 255, 255)
End With
Case Is = "Half"
With ActiveSheet.Shapes("Rectangle 5")
.Fill.ForeColor.RGB = RGB(138, 0, 0)
.TextFrame.Characters.Font.Color = RGB(255, 255, 255)
End With
Case Is = "NA"
With ActiveSheet.Shapes("Rectangle 5")
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.TextFrame.Characters.Font.Color = RGB(166, 166, 166)
End With
End Select
End If
End Sub
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,149
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
The characters & case are an exact match so it's not that...

Here's what I have so far...
Your code works correctly for me when I type or paste those keyword into E8 and F8. Do you have any other event code in your project (if yes, maybe it's interfering in some way)?
 

Forum statistics

Threads
1,136,355
Messages
5,675,305
Members
419,560
Latest member
g3org

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