简体   繁体   中英

Change actual font color based on another cell value in the Row

I currently have a worksheet that looks into column B and matches the string with a String in Column Z then changes the color of the matching String to font.color in column B. The problem is that column B is colored by conditional formatting so the code is unrecognized. I need to be able to have the actual font color change in column B when the condtion is true. In addition, the code would need to be incremented until the last row of the sheet is reach.

Here's the current conditional formats I have setup

Blockquote

=ISNUMBER(SEARCH("Story",Template!D5))=TRUE 'format dark blue
=ISNUMBER(SEARCH("Requirement",Template!D5))=TRUE 'format green
=ISNUMBER(SEARCH("EPIC",Template!D5))=TRUE 'format red
=ISNUMBER(SEARCH("Test",Template!D5))=TRUE 'format teal
=ISNUMBER(SEARCH("New Feature",Template!D5))=TRUE 'format orange
=ISNUMBER(SEARCH("Theme",Template!D5))=TRUE 'format gray

Blockquote

Sub Main()
  Call NoLinks
  Call SetCellWarning
  Call colortext
End Sub

Sub NoLinks()
ActiveSheet.Hyperlinks.Delete
End Sub

Sub SetCellWarning()
    Dim iLastRow As Long
    Dim cel As Range, rSetColumn As Range

    iLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row

    Set rSetColumn = Range(Cells(5, 26), Cells(iLastRow, 26)) ' Column "Z"...

    For Each cel In rSetColumn
        If cel.Value = "" Then
            With cel
                cel.Value = "NOT MAPPED"
            End With
        End If
    Next cel

End Sub

***'The colortext runs but does not update unless the font color is manually updated***    
Sub colortext()
start_row = 5
key_col = 2
linked_col = 26
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
    o = start_row 'start with row one for second column
    Do While Not IsEmpty(Cells(o, linked_col)) 'Do until empty cell
    If Not InStr(1, Cells(o, linked_col), Cells(i, key_col)) = 0 Then  'if cell    contents found in cell
        With Cells(o, linked_col).Characters(Start:=InStr(1, Cells(o, linked_col), Cells(i, key_col)), Length:=Len(Cells(i, key_col))).Font
            .Color = Cells(i, key_col).Font.Color  'change color of this part of the cell
        End With
    End If
    o = o + 1 'increment the cell in second column
    Loop
    i = i + 1 'increment the cell in the first column
Loop
End Sub

Blockquote

Just in case you simply want "the solution you tried before" to work, here is how you get the conditional formatting working:

  1. Select the cells (in column B) to which you want to apply the conditional formatting
  2. Click on "conditional formatting" button. Clear any rules you no longer want, then create a "new rule" based on "an equation being true"
  3. Enter the following equation: =ISNUMBER(SEARCH(B1, "EPIC"))
  4. Select the format you want for cells with the text "EPIC" in them (note - with this order of "SEARCH", we look for the text in B1 to be contained in the phrase "EPIC", so "E" will match, as will "IC". If you want only cells with "That was EPIC" to be matched, you need to reverse the order of the arguments
  5. Add more rules for the other words you want to match, and the color you need

This is what the dialog looks like when you have just created a single rule:

在此处输入图片说明

And this is what the "conditional formatting" dialog looks like after you have completed the second rule (in my example, I applied these rules to 8 cells):

在此处输入图片说明

At this point, the spreadsheet looks like this:

在此处输入图片说明

This seems to be what you were asking for... if it's not, then please clarify in the comments!

Getting rid of the conditional formatting is easy:

If (Cells(i, key_col).FormatConditions.Count > 0) Then
    Cells(i, key_col).FormatConditions.Delete 
End If
.Color = Cells(i, key_col).Font.Color  'change color of this part of the cell

You can even store it in a FormatCondition variable and apply to the cell later if you wish.

Here's the winning solution:

Sub colorkey()

start_row = 5
key_col = 2
flag_col = 4

i = start_row 'start on row one

Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell

Tval = Cells(i, flag_col).Value
Select Case Tval
Case "Requirement"
    'cval = green
    cVal = 10
Case "New Feature"
    'cval = orange
    cVal = 46
Case "Test"
    'cval = lt blue
    cVal = 28
Case "Epic"
    'cval = red
    cVal = 3
Case "Story"
    'cval = dk blue
    cVal = 49
Case "Theme"
    'cval = grey
    cVal = 48
Case "NOT MAPPED"
    'cval = Maroon
    cVal = 53
End Select
Cells(i, key_col).Font.ColorIndex = cVal

i = i + 1 'increment the row
Loop

End Sub

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