Display a part of a cell in green (or red)...

[Anne P]

.... according to the value of a cell hosted in another worksheet...

Hi,

My cell A4 of the worksheet "Dashboard" is:
="Evolution of " & TEXT('Global Data'!C39;"#%") & " from previous month"

It displays:
Evolution of 39% from previous month

I would like that if 'Global Data'!C39 >= 0, "& TEXT('Global
Data'!C39;"#%")" is written in green, else it is written in red

I think the only solution is to add code ... However I do not know a lot in
VB...

Can someone help?

Thanks

 

[Bernie Deitrick]

Anne,

Name cell A4 of "Dash Board" ColorEvolution, and name cell C39 of "Global Data" DSource. (Using
names instead of cell addresses will ensure that the code works even if you or your user inserts
rows or columns somewhere.)

Copy the code below, right-click the sheet tab of "DashBoard" and select "View Code" then paste the
code into the window that appears.

Then, in another cell on Dash Board, type
=DSource
Having that link will force a calculation of Dash Board any time there is a change in DSource, which
will then fire the calculate event below.

In the line

.ColorIndex = IIf(myV.Value >= 0, 50, 3)

50 is the green and 3 is the red, so if you want to change the specific color, do it there.

HTH,
Bernie
MS Excel MVP

Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Dim myFR As Range
Dim myV As Range

Set myV = Worksheets("Global Data").Range("Dsource")
Set myFR = Range("ColorEvolution")

With myFR
.Value = "Evolution of " & Format(myV.Value, "#%") & " from previous month"
With .Characters(Start:=14, Length:=Len(Format(myV.Value, "#%"))).Font
.ColorIndex = IIf(myV.Value >= 0, 50, 3)
End With
End With
Application.EnableEvents = True
End Sub

 

[Anne P]

Hello Bernie,

Thank you for your clear answer, I have been able to integrate it in my
worksheet, + it works.

Now, I am trying to replicate the code so that this appears for several data
in the same worksheet, but it does not apply... The debug feature do not find
any error though.

My code:

Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Dim myFR As Range
Dim myV As Range

Set myV = Worksheets("Global Data").Range("Dsource")
Set myFR = Range("ColorEvolution")

With myFR
.Value = "Evolution of " & Format(myV.Value, "#%") & " from previous month"
With .Characters(Start:=14, Length:=Len(Format(myV.Value, "#%"))).Font
.ColorIndex = IIf(myV.Value >= 0, 50, 3)
End With
End With
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Calculate2()
Application.EnableEvents = False
Dim myFR2 As Range
Dim myV2 As Range

Set myV2 = Worksheets("Global Data").Range("RateVisitors")
Set myFR2 = Range("EvolutionVisitors")

With myFR2
.Value = "Evolution of " & Format(myV2.Value, "#%") & " from previous
month"
With .Characters(Start:=14, Length:=Len(Format(myV2.Value, "#%"))).Font
.ColorIndex = IIf(myV2.Value >= 0, 50, 3)
End With
End With
Application.EnableEvents = True
End Sub

Could you please let me know what is wrong with this code??? I would need to
replicate it at least 5 times on the worksheet.

Thank you for your precious help on this!

Anne

 

[Bernie Deitrick]

Anne,

You only get one event, so you need to put all your code together - you could use somthing like the
first procedure, where you reuse the variables.

But a better approach would be to improve your naming convention to allow you to loop through the
cells without adding code sections for each pair, for an unlimited number of pairs. So, name the
source cells DSource1, DSource2, etc. and the evolving cells ColorEvolution1, ColorEvolution2, etc.,
then use the second procedure. Just make sure that you have consecutive names for the ranges - the
code starts at DSource1, and when it doesn't find DSourceN, it quits.

HTH,
Bernie
MS Excel MVP

Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Dim myFR As Range
Dim myV As Range

Set myV = Worksheets("Global Data").Range("Dsource")
Set myFR = Range("ColorEvolution")

With myFR
.Value = "Evolution of " & Format(myV.Value, "#%") & " from previous month"
With .Characters(Start:=14, Length:=Len(Format(myV.Value, "#%"))).Font
.ColorIndex = IIf(myV.Value >= 0, 50, 3)
End With
End With

'Re-use the variables and do the same thing again:
Set myV = Worksheets("Global Data").Range("RateVisitors")
Set myFR = Range("EvolutionVisitors")

With myFR
.Value = "Evolution of " & Format(myV.Value, "#%") & " from previous Month """
With .Characters(Start:=14, Length:=Len(Format(myV.Value, "#%"))).Font
.ColorIndex = IIf(myV.Value >= 0, 50, 3)
End With
End With

Application.EnableEvents = True
End Sub

'Use this version if you change your naming convention
Private Sub Worksheet_Calculate()
Dim myFR As Range
Dim myV As Range
Dim i As Integer

i = 0

On Error GoTo Finished
Application.EnableEvents = False

TryAgain:

i = i + 1

Set myV = Worksheets("Global Data").Range("Dsource" & i)
Set myFR = Range("ColorEvolution" & i)

With myFR
.Value = "Evolution of " & Format(myV.Value, "#%") & " from previous month"
With .Characters(Start:=14, Length:=Len(Format(myV.Value, "#%"))).Font
.ColorIndex = IIf(myV.Value >= 0, 50, 3)
End With
End With

GoTo TryAgain

Finished:

Application.EnableEvents = True
End Sub