VBA to change the text colour in a shape

C

cjcass

Well-known Member
Joined
Oct 27, 2011
Messages
679
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

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sort by date Sort by votes
cjcass said:
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
Click to expand...
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
 
Upvote 0
Rick Rothstein said:
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
Click to expand...

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
 
Upvote 0
cjcass said:
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?
Click to expand...
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
 
Upvote 0
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,
 
Upvote 0
cjcass said:
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...
Click to expand...

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?
 
Upvote 0
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,
 
Upvote 0
cjcass said:
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...
Click to expand...
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.
 
Upvote 0
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
 
Upvote 0
cjcass said:
The characters & case are an exact match so it's not that...

Here's what I have so far...
Click to expand...
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)?
 
Upvote 0
You must log in or register to reply here.

Similar threads

Phil Payne
  • Solved
Changing rectangle shape colour using VBA.
Replies
2
Views
740
Phil Payne
Phil Payne
A
  • Question
VBA to change cell colour based on content
Replies
3
Views
144
Snakehips
Snakehips
S
  • Solved
Excel VBA to Cycle Through Colours / Texture Fills Of Shape
Replies
4
Views
668
stuarto606
S
O
  • Question
Change node shape colour based on text within shape
Replies
1
Views
428
Domenic
D
L
  • Question
Conditional Formatting vba + Reverting the Conditional Formatting if no data
Replies
1
Views
139
leila
L

Forum statistics

Threads
1,214,547
Messages
6,120,139
Members
448,948
Latest member
spamiki

Share this page

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
Back
Top