Active cell font color change

[Rejje]

Hi!

I'm trying to make the font color of the selected range within a worksheet temporarily change to a specific rgb. When not selected THEN change back to original font color setting.

However I'm not very successful...

Paste these codes into worksheet event while having another worksheet activated.

I've have started with below code. This changes the cell color, not the font color. It works allthough not without some possibilities of imrovement.

[LEFT][COLOR=blue]Const[/COLOR] activeFill [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR] = 255 [COLOR=darkgreen]'<--Use sub 'a' below to find the right value for your color of choice.[/COLOR]
[COLOR=blue]Dim[/COLOR] oldCell [COLOR=blue]As[/COLOR] Range 
[COLOR=blue]Dim[/COLOR] oldCellFill [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR] 
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Worksheet_Activate() 
    [COLOR=blue]Set[/COLOR] oldCell = Selection 
    oldCellFill = Selection.Interior.Color 
    Selection.Interior.Color = activeFill 
[COLOR=blue]End Sub[/COLOR] 
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Worksheet_Deactivate() 
    [COLOR=blue]If[/COLOR] oldCellFill = 16777215 [COLOR=blue]Then[/COLOR] [COLOR=darkgreen]'<--Workaround for no fill[/COLOR]
        oldCell.Interior.ColorIndex = 0 
    [COLOR=blue]Else[/COLOR] 
        oldCell.Interior.Color = oldCellFill 
    [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
    [COLOR=blue]Set[/COLOR] oldCell = [COLOR=blue]Nothing[/COLOR] 
[COLOR=blue]End Sub[/COLOR] 
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Worksheet_SelectionChange([COLOR=blue]ByVal[/COLOR] Target [COLOR=blue]As[/COLOR] Range) 
    [COLOR=blue]If[/COLOR] oldCellFill = 16777215 [COLOR=blue]Then[/COLOR] 
        oldCell.Interior.ColorIndex = 0 
    [COLOR=blue]Else[/COLOR] 
        oldCell.Interior.Color = oldCellFill 
    [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
    [COLOR=blue]Set[/COLOR] oldCell = Target 
    oldCellFill = Target.Interior.Color 
    Target.Interior.Color = activeFill 
[COLOR=blue]End Sub[/COLOR] 
[COLOR=blue]Sub[/COLOR] a() 
    [COLOR=blue]Debug.Print[/COLOR] RGB(256, 0, 0) 
[COLOR=blue]End Sub[/COLOR] [/LEFT]

This is what I've tried for making font color temp change. Note there's no need for the workaround for no fill with font color (I think at least).

Const activeFontThemeColor As Long = -16776961 '<--Use sub 'a' below to find the right value for your color of choice.
Dim oldCell As Range
Dim oldCellFontThemeColor As Long
Private Sub Worksheet_Activate()
    Set oldCell = Selection
    oldCellFontThemeColor = Selection.Font.ThemeColor
    Selection.Font.ThemeColor = activeFontThemeColor
End Sub
Private Sub Worksheet_Deactivate()
    oldCell.Font.ThemeColor = oldCellFontThemeColor
    Set oldCell = Nothing
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set oldCell = Target
    oldCell.Font.ThemeColor = oldCellFontThemeColor
    oldCellFontThemeColor = Target.Font.ThemeColor
    Target.Font.ThemeColor = activeFontThemeColor
End Sub
Sub a()
    Debug.Print RGB(256, 0, 0)
End Sub

Does anyone have a clue of how to get this to work?

 

[venkat1926]

I am thinking on different lines

suppose your sheet is shee1. some data are there in the cells

rightclick this sheet tab and click view code and copy this event code
(you can modify the event code)

now select any cell or range of cells and see what happens

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
ActiveSheet.Cells.Font.ColorIndex = xlAutomatic
Selection.Cells.Font.Color = RGB(256, 0, 0)
Application.EnableEvents = True
End Sub

 

[Rejje]

I am thinking on different lines

suppose your sheet is shee1. some data are there in the cells

rightclick this sheet tab and click view code and copy this event code
(you can modify the event code)

now select any cell or range of cells and see what happens

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
ActiveSheet.Cells.Font.ColorIndex = xlAutomatic
Selection.Cells.Font.Color = RGB(256, 0, 0)
Application.EnableEvents = True
End Sub

Well it performs as wanted with selection but this code sets everything else to a specific color, in this case black.

In my case with lots of blue hyperlinks, red fonts for invalid text etc. this doesn't work. But of course: A good suggestion.

So my code needs to remember the color any cell had before becoming selected. Here's where it seems to become tricky and above my current vba skills.

 

[venkat1926]

if hyperlinks is the only problem try this modified macro

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
'ActiveSheet.Cells.Font.ColorIndex = xlAutomatic
For Each c In ActiveSheet.UsedRange
If c.Hyperlinks.Count = 1 Then
c.Font.ColorIndex = 5
Else
c.Font.ColorIndex = xlAutomatic
End If
Next c
Selection.Cells.Font.Color = RGB(256, 0, 0)
Application.EnableEvents = True
End Sub

 

[Rejje]

This works!

However my Excel project is pretty big in terms of calculation etc. so I recommend adding to the code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each c In ActiveSheet.UsedRange
    If c.Hyperlinks.Count = 1 Then
        c.Font.ColorIndex = 5
    Else
        c.Font.ColorIndex = xlAutomatic
    End If
Next c
Selection.Cells.Font.Color = RGB(256, 0, 0)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

If one doesn't disable calculation and screen updating the loop for coloring the hyperlinks takes forever in a hefty workbook and especially if the used range of the worksheet includes a lot of cells.

Thanks Venkat and solved!

 

[venkat1926]

you are welcome. yes you are right in disabling calculation if it is large data base. both this and screenupdating is common features in a macro when necessary. I have given only the core macro. good you have added these.
glad the macro was useful.