How to change text color to different color after rewrite cell?

Lacan

Board Regular
Joined
Oct 5, 2016
Messages
167
Office Version
  1. 365
Platform
  1. Windows
Hello Guys,

Using VBA how can change text color to different color after rewrite text cell?

Thank you very much for the help.
 
Assuming my understanding in post #10 of what you want is correct, try this:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Const colorOdd As Long = vbBlack
Const colorEven As Long = vbBlue
Static N As Long
If IsEmpty(Range("H1")) Or Target.Address <> Range("H1").Address Then Exit Sub
N = N + 1
With Range("F5:I5")
    If N Mod 2 <> 0 Then
        With .Font
            .Bold = False
            .Color = colorOdd
        End With
    Else
        With .Font
            .Bold = True
            .Color = colorEven
        End With
    End If
End With
End Sub
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Dear @JoeMo (y)?

Let me clarify even better the font is standard (default) independently if "H1" is empty or not.
After change it cell "H1" want all range from F5:I5 with format text bold colour text blue 255 #0000FF.
And after make another change in cell "H1"want to return again all range from F5:I5 with format text standard (default).
And so on.

Give your VBA baseline that you write a few months ago:

Private Sub Worksheet_Change(ByVal Target As Range)
Const color1 As Long = vbBlack
Const color2 As Long = vbBlue
Dim c As Range
If Not Intersect(Target, Range("H5")) Is Nothing Then 'Change range to suit
For Each c In Intersect(Target, Range("H5"))
If Not IsEmpty(c) Then
If c.Font.Color = color1 Then
With c.Font
.Color = color2
.Bold = True
End With
ElseIf c.Font.Color = color2 Then
With c.Font
.Color = color1
.Bold = False
End With
End If
End If
Next c
End If
End Sub


Your VBA baselied applied in example table:
Livro1.xlsx
EFGHIJK
2
3
4N.º ITEMPRODUTQUANTITYPVP
5235TV55 €
6
7
8
9
Folha3
 
Upvote 0
Assuming my understanding in post #10 of what you want is correct, try this:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Const colorOdd As Long = vbBlack
Const colorEven As Long = vbBlue
Static N As Long
If IsEmpty(Range("H1")) Or Target.Address <> Range("H1").Address Then Exit Sub
N = N + 1
With Range("F5:I5")
    If N Mod 2 <> 0 Then
        With .Font
            .Bold = False
            .Color = colorOdd
        End With
    Else
        With .Font
            .Bold = True
            .Color = colorEven
        End With
    End If
End With
End Sub
Excellet @JoeMo ????

Works beatifull.
To finish would like to applied your vba code in a extended range like:

Livro1.xlsm
EFGHIJK
3
4N.º ITEMPRODUTQUANTITYPVP
5235TV25 €
6400APPLE210 €
7605MAC156 €
8896CUP52 €
9532RICE64 €
10
11
Folha3


Thank you very much @JoeMo.??
 
Upvote 0
Excellet @JoeMo ????

Works beatifull.
To finish would like to applied your vba code in a extended range like:

Livro1.xlsm
EFGHIJK
3
4N.º ITEMPRODUTQUANTITYPVP
5235TV25 €
6400APPLE210 €
7605MAC156 €
8896CUP52 €
9532RICE64 €
10
11
Folha3


Thank you very much @JoeMo.??
You are welcome. Regarding your new request, don't know what you mean by "extended" range. Please provide more information.
 
Upvote 0
You are welcome. Regarding your new request, don't know what you mean by "extended" range. Please provide more information.
Big @JoeMo

Very simple the goal is to replicate formula vba code in range H5:H9.
In every change in range H5:H9 format text in row corresponding range.
Like table below example made change in cell H6 in H8 and corresponding format row (to show example made format by hand).

Thank you very much @JoeMo.??


Livro1.xlsm
EFGHIJK
3
4N.º ITEMPRODUTQUANTITYPVP
5235TV25 €
6400APPLE310 €
7605MAC156 €
8896CUP92 €
9532RICE64 €
10
11
Folha3
 
Upvote 0
Try this:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Const colorOdd As Long = vbBlack
Const colorEven As Long = vbBlue
Static N() As Long
Dim R As Range, c As Range  'R will be the range you want to monitor for changes
Set R = Range("H5:H9")
ReDim Preserve N(1 To R.Rows.Count)
If Not Intersect(Target, R) Is Nothing Then
    For Each c In Intersect(Target, R)
        N(c.Row - R(1).Row + 1) = N(c.Row - R(1).Row + 1) + 1
        With Range("F" & c.Row, "I" & c.Row)
            If N(c.Row - R(1).Row + 1) Mod 2 <> 0 Then
                With .Font
                    .Bold = False
                    .Color = colorOdd
                End With
            Else
                With .Font
                    .Bold = True
                    .Color = colorEven
                End With
            End If
        End With
    Next c
End If
End Sub
 
Upvote 0
Try this:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Const colorOdd As Long = vbBlack
Const colorEven As Long = vbBlue
Static N() As Long
Dim R As Range, c As Range  'R will be the range you want to monitor for changes
Set R = Range("H5:H9")
ReDim Preserve N(1 To R.Rows.Count)
If Not Intersect(Target, R) Is Nothing Then
    For Each c In Intersect(Target, R)
        N(c.Row - R(1).Row + 1) = N(c.Row - R(1).Row + 1) + 1
        With Range("F" & c.Row, "I" & c.Row)
            If N(c.Row - R(1).Row + 1) Mod 2 <> 0 Then
                With .Font
                    .Bold = False
                    .Color = colorOdd
                End With
            Else
                With .Font
                    .Bold = True
                    .Color = colorEven
                End With
            End If
        End With
    Next c
End If
End Sub
Big @JoeMo

Was trying some tests in sheet almost perfect!
Can you ativate not at 2nd write but at 1st write?

Thank you so much.???????????
 
Upvote 0
Here you go:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Const colorOdd As Long = vbBlue
Const colorEven As Long = vbBlack
Static N() As Long
Dim R As Range, c As Range  'R will be the range you want to monitor for changes
Set R = Range("H5:H9")
ReDim Preserve N(1 To R.Rows.Count)
If Not Intersect(Target, R) Is Nothing Then
    For Each c In Intersect(Target, R)
        N(c.Row - R(1).Row + 1) = N(c.Row - R(1).Row + 1) + 1
        With Range("F" & c.Row, "I" & c.Row)
            If N(c.Row - R(1).Row + 1) Mod 2 = 0 Then
                With .Font
                    .Bold = True
                    .Color = colorOdd
                End With
            Else
                With .Font
                    .Bold = False
                    .Color = colorEven
                End With
            End If
        End With
    Next c
End If
End Sub
 
Upvote 0
I modified the code in post #18 slightly and think it should be coupled with a workbook_open event to set everything in the target range to non-bold, black font when the workbook is opened.
This code goes in a ThisWorkbook module:
VBA Code:
Private Sub Workbook_Open()
With Me.Sheets("Sheet1")  'adjust sheet name to suit
    With .Range("F5:I9").Font   'adjust range to suit
        .Color = vbBlack
        .Bold = False
    End With
End With
End Sub
and this code in the worksheet as before:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Const colorOdd As Long = vbBlue
Const colorEven As Long = vbBlack
Static N() As Long
Dim R As Range, c As Range  'R will be the range you want to monitor for changes
Set R = Range("H5:H9")
ReDim Preserve N(1 To R.Rows.Count)
If Not Intersect(Target, R) Is Nothing Then
    For Each c In Intersect(Target, R)
        N(c.Row - R(1).Row + 1) = N(c.Row - R(1).Row + 1) + 1
        With Range("F" & c.Row, "I" & c.Row)
            If N(c.Row - R(1).Row + 1) Mod 2 = 0 Then
                With .Font
                    .Bold = False
                    .Color = colorEven
                End With
            Else
                With .Font
                    .Bold = True
                    .Color = colorOdd
                End With
            End If
        End With
    Next c
End If
End Sub
 
Upvote 0
Solution
I modified the code in post #18 slightly and think it should be coupled with a workbook_open event to set everything in the target range to non-bold, black font when the workbook is opened.
This code goes in a ThisWorkbook module:
VBA Code:
Private Sub Workbook_Open()
With Me.Sheets("Sheet1")  'adjust sheet name to suit
    With .Range("F5:I9").Font   'adjust range to suit
        .Color = vbBlack
        .Bold = False
    End With
End With
End Sub
and this code in the worksheet as before:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Const colorOdd As Long = vbBlue
Const colorEven As Long = vbBlack
Static N() As Long
Dim R As Range, c As Range  'R will be the range you want to monitor for changes
Set R = Range("H5:H9")
ReDim Preserve N(1 To R.Rows.Count)
If Not Intersect(Target, R) Is Nothing Then
    For Each c In Intersect(Target, R)
        N(c.Row - R(1).Row + 1) = N(c.Row - R(1).Row + 1) + 1
        With Range("F" & c.Row, "I" & c.Row)
            If N(c.Row - R(1).Row + 1) Mod 2 = 0 Then
                With .Font
                    .Bold = False
                    .Color = colorEven
                End With
            Else
                With .Font
                    .Bold = True
                    .Color = colorOdd
                End With
            End If
        End With
    Next c
End If
End Sub
Brilliant @JoeMo !!! ??
Works Perfect!!! ??
Thank you very much my Friend. ????
 
Upvote 0

Forum statistics

Threads
1,216,116
Messages
6,128,932
Members
449,480
Latest member
yesitisasport

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