简体   繁体   中英

How to change font color AFTER Macro is run

I'm looking to change the color of text I'm entering based on the date it's entered into the document. Right now I have a cell in the worksheet that recognizes the current date =TEXT(TODAY(), "dddd") . And then the following VBA code:

  If Range("A1").Value = "Thursday" Then Cells.Font.ColorIndex = 5

The issue is it changes ALL the text in the document - I only want the cells that I type after I run the macro to have a color index of 5. I don't want to specify a range because the range will change for each row depending on where the last text is entered, and I think there's and easier way than looping through each row and finding the last column. I'd like a macro that will identify the day, assign a color to anything I type on each day - Monday blue, Tuesday red, etc. I'd appreciate any help, especially on changing the color of only text written after the macro is run!

You can do this with a worksheet change event. Go to the module for the worksheet that you want this implemented on (Right-click on the tab and hit View Code), then enter the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    For Each c In Target
        Select Case LCase(c.Value)
            Case "monday": c.Font.ColorIndex = 5
            Case "tuesday": c.Font.ColorIndex = 4
        End Select
    Next
End Sub

This code will run whenever a change occurs on the worksheet (it will not apply to existing cells, unless they are updated).

Open up VBA and instead of creating a module, right click on Sheet1 --> View Code. That should open an area for you to code. Go to the upper right-hand corner and select Change. After each time you changed the value of the cell that you have selected the code should run.

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Format(Now, "dddd") = "Thursday" Then
            Target.Font.ColorIndex = 5
       End If
    End Sub

Should look something like this. Or this:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Select Case Format(Now, "dddd")
        Case "Sunday"
            Target.Font.ColorIndex = 1
        Case "Monday"
            Target.Font.ColorIndex = 2
        Case "Tuesday"
            Target.Font.ColorIndex = 3
        Case "Wednesday"
            Target.Font.ColorIndex = 4
        Case "Thursday"
            Target.Font.ColorIndex = 5
        Case "Friday"
            Target.Font.ColorIndex = 6
        Case "Saturday"
            Target.Font.ColorIndex = 7
        End Select
    End Sub

Obviously the colors can be whatever you want, but it changes based on what day it actually is and not what you type.

Last one I thought of is:

Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Font.ColorIndex = Weekday(Now)
End Sub

If you want to color any cell that was changed in your sheet based on the day it has been changed, you should try the code below. It doesn't look for a "Monday" value in a cell, it colors all cells that were changed on Monday. I'm using Now() to tell the code the moment in time the cell is actually changed and then I'm using Datepart to extract the day's index (somewhat like the name, in this case from 1 to 7).

Private Sub Worksheet_Change(ByVal Target As Range)
CurDay = DatePart("w", Now())
Dim c As Range
For Each c In Target
    If CurDay = 0 Then '0 is impossible just to keep the code "clean"
        ElseIf CurDay = 2 Then c.Font.ColorIndex = 5 '2 is by default Monday
        ElseIf CurDay = 3 Then c.Font.ColorIndex = 6 'etc
        ElseIf CurDay = 4 Then c.Font.ColorIndex = 7 'etc
        ElseIf CurDay = 5 Then c.Font.ColorIndex = 8 'etc
        ElseIf CurDay = 6 Then c.Font.ColorIndex = 9 'etc
        ElseIf CurDay = 7 Then c.Font.ColorIndex = 10 'etc
        ElseIf CurDay = 1 Then c.Font.ColorIndex = 11 ' Sunday
    End If
Next
End Sub

Tested it, works like a charm! Hope this was what you were looking for. :)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM