Solved: Temporarily Change BG and Font Color of Active Cell

[Opv]

I am trying to temporarily change the following for the Active Cell:

Background Color
Font Color
Font = Bold

The following seems to work for the background; however, I can't seem to figure out how to make it change the font color and bold the text.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Static rngPrev As Range, PrevColor As Integer
Dim TempColor As Integer
TempColor = Target.Cells(1, 1).Interior.ColorIndex

If Not rngPrev Is Nothing Then rngPrev.Interior.ColorIndex = PrevColor
PrevColor = TempColor

With Target.Interior
.ColorIndex = 1
.Pattern = xlSolid
End With
Set rngPrev = Target

End Sub

How can I change this to include a temporary change to the font color and bold status, where it changes back to the original state once the cell is no longer the active cell?

[lucas]

add another with statement to handle the font:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static rngPrev As Range, PrevColor As Integer
Dim TempColor As Integer
TempColor = Target.Cells(1, 1).Interior.ColorIndex
If Not rngPrev Is Nothing Then rngPrev.Interior.ColorIndex = PrevColor
PrevColor = TempColor
With Target.Interior
.ColorIndex = 1
.Pattern = xlSolid
End With
With Target.Font
.Bold = True
.ColorIndex = 46
End With
Set rngPrev = Target
End Sub

by the way, welcome to the board. You can format your code for the forum by selecting it when posting and hitting the vba button.

[mbarron]

This will change the font to the opposite Bold setting and the color to Red for the highlighted cells.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Static rngPrev As Range, PrevColor As Integer, PrevFColor As Integer, PrevBold As Boolean
Dim TempColor As Integer, TempFColor As Integer, TempBold As Boolean

TempColor = Target.Cells(1, 1).Interior.ColorIndex
TempFColor = Target.Cells(1, 1).Font.ColorIndex
TempBold = Target.Cells(1, 1).Font.Bold

If Not rngPrev Is Nothing Then
rngPrev.Interior.ColorIndex = PrevColor
rngPrev.Font.ColorIndex = PrevFColor
rngPrev.Font.Bold = PrevBold

End If

PrevColor = TempColor
PrevFColor = TempFColor
PrevBold = TempBold
With Target.Interior
.ColorIndex = 1
.Pattern = xlSolid
End With

With Target.Font
.Bold = Not (TempBold)
.ColorIndex = 3
End With

Set rngPrev = Target

End Sub

[Opv]

Thanks. That partially works, but it leaves the font color and bold status after I leave the cell. How would I assure it gets changed back to it's former state after I click on another cell?

[Opv]

Thanks, MBarron. That does the trick. I appreciate the help.

Opv

[lucas]

I saw that after I posted. I see mbarron has offered a solution. Since I did this I will post it. It works on a double click to change the color, font color and bold, a single click outside the target cell resets it:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target

If .Interior.ColorIndex = 1 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 1
End If
If .Font.ColorIndex = 6 Then
.Font.ColorIndex = 0
Else
.Font.ColorIndex = 6
End If
If .Font.Bold = True Then
.Font.Bold = False
Else
.Font.Bold = True
End If
Cancel = True
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Cells
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Bold = False
End With


One advantage to this method is that you are not left with a black cell on the sheet.

[Opv]

Thanks, Lucas.

[lucas]

If you have a solution, be sure to mark your thread solved to keep others from reading the entire thread just to find out it's been resolved.

use thread tools at the top of the page.

[Opv]

If you have a solution, be sure to mark your thread solved to keep others from reading the entire thread just to find out it's been resolved.

use thread tools at the top of the page.
I'm having some additional thoughts about the solution to this question. Now I'm wondering how difficult it would be to expand the code to highlight the active row (only the cells with data and not the entire row)?

[Opv]

Well, I thought I had solved my problem by using:

Target.Offset("A1:A3")

However, the defined range moves with the active cell. I am seeking a way to highlight only the first three cells (or whatever range I might need starting with the cell in Column A of the active row) regardless of which cell within the row is the active cell.

Thanks,

Opv

[SamT]

If .Interior.ColorIndex = 1 Then
Range(Target & ":" & Target(Offset(0,3)).Interior.ColorIndex = xlNone

[Opv]

If .Interior.ColorIndex = 1 Then
Range(Target & ":" & Target(Offset(0,3)).Interior.ColorIndex = xlNone


Thanks. I'm having a bit of a problem getting the suggested change to work. I probably should move the current discussion to a new thread since this thread has been marked as "solved," as my current project is not identical to the one in which I incorporated the original solution.

[SamT]

Typo:

Range(Target & ":" & Target.Offset(0,3)).Interior.ColorIndex = xlNone

[Opv]

As I said, this project is slightly different from the one that prompted my original question in this post. It still relates to the general topic, but it relates to a different workbook and a slightly different need. I apologize for starting this discussion in the same thread. But, since I've started it, I'll go ahead and post the code I'm working with. Perhaps the solution to this related question will prove helpful to someone down the road.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Data As Range
Dim i As Integer
Dim k As Integer 'ActiveCell

i = 1
k = ActiveCell.Column()
Set Data = Range("A1:C1")

Data.Interior.ColorIndex = xlNone

With ActiveCell
.Offset(0, -(k - i)).Resize(1, 3).Interior.ColorIndex = 1
.Offset(0, -(k - 1)).Resize(1, 3).Font.Bold = True
.Offset(0, -(k - 1)).Resize(1, 3).Font.ColorIndex = 2

End With

End Sub


This code everything I need it to do except change the new attributes back to their default once I click in a different row. What do I need to add to reverse the action once I click on a different row?

[lucas]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Data As Range
Dim i As Integer
Dim k As Long 'ActiveCell

i = 1
k = ActiveCell.Column()
Set Data = Range("A:C")

Data.Interior.ColorIndex = xlNone
Data.Font.Bold = False
Data.Font.ColorIndex = 0
'
With ActiveCell
.Offset(0, -(k - i)).Resize(1, 3).Interior.ColorIndex = 1
.Offset(0, -(k - 1)).Resize(1, 3).Font.Bold = True
.Offset(0, -(k - 1)).Resize(1, 3).Font.ColorIndex = 2

End With

End Sub

[Opv]

Thanks, Lucas. That does the trick. I appreciate everyone's help.

Opv

[lucas]

You're welcome and don't worry too much about accidentally marking your thread solved.

It happens all the time and often followup questions arise.

Just remember that most of us have our profile set up to get an email if new posts are added to threads we are subscribed to and the thread gets moved to the top of the que when it gets new posts so usually folks will notice even if it's marked solved.

The new question wasn't so far afield to require a new thread. We get project creep a lot. It happens.

We appreciate you thinking about it.