Change color of text in a cell of excel

Question

I would like to change the color of a text in a cell in MS Excel like the conditioned formatting. I have different text in one cell, e.g. "WUG-FGT" or "INZL-DRE". I would like to format the cells (all cells in my workshhet), that a defined text like "WUG-FGT" appears red and the other text "INZL-DRE" green, but the text is in the same cell. With "sandard" conditioned formatting I only get the backgroud coloured.

A similar questions is this: How can I change color of text in a cell of MS Excel?

But the difference is that I (actually) don't work with programming. That means that I need a more simple or easy solution to implement this in my excel file.

Is this possible? A solution with VBA would also be possible, I know how to implement them.

Answer 1

here example how you can achieve required results:

Sub test()
    Dim cl As Range
    Dim sVar1$, sVar2$, pos%
    sVar1 = "WUG-FGT"
    sVar2 = "INZL-DRE"
    For Each cl In Selection
        If cl.Value2 Like "*" & sVar1 & "*" Then
            pos = InStr(1, cl.Value2, sVar1, vbTextCompare)
            cl.Characters(pos, Len(sVar1)).Font.Color = vbRed
        End If
        If cl.Value2 Like "*" & sVar2 & "*" Then
            pos = InStr(1, cl.Value2, sVar2, vbTextCompare)
            cl.Characters(pos, Len(sVar2)).Font.Color = vbGreen
        End If
    Next cl
End Sub

test

UPDATE

Is it possible to count how often the word has been detected. Either to write to total amount to a defined cell or what also would be great, to add the number of counts in brackets behind the word with an control variable? So in your example: A2: "WUG-FGT(1)", A4: "WUG-FGT(2)", A5: "WUG-FGT(3)"

Yes, but you should update the cell before colorizing, otherwise whole cell font will be colorized by the first char's color (e.g. cell contains both keywords and first is red, and second is green, after update whole cell font will be red). See updated code and test bellow:

Sub test_upd()
    Dim cl As Range, sVar1$, sVar2$, pos%, cnt1%, cnt2%
    Dim bVar1 As Boolean, bVar2 As Boolean

    sVar1 = "WUG-FGT": cnt1 = 0
    sVar2 = "INZL-DRE": cnt2 = 0

    For Each cl In Selection
        'string value should be updated before colorize
        If cl.Value2 Like "*" & sVar1 & "*" Then
            bVar1 = True
            cnt1 = cnt1 + 1
            cl.Value2 = Replace(cl.Value, sVar1, sVar1 & "(" & cnt1 & ")")
        End If

        If cl.Value2 Like "*" & sVar2 & "*" Then
            bVar2 = True
            cnt2 = cnt2 + 1
            cl.Value2 = Replace(cl.Value, sVar2, sVar2 & "(" & cnt2 & ")")
        End If

        pos = InStr(1, cl.Value2, sVar1, vbTextCompare)
        If bVar1 Then cl.Characters(pos, Len(sVar1)).Font.Color = vbRed
        pos = InStr(1, cl.Value2, sVar2, vbTextCompare)
        If bVar2 Then cl.Characters(pos, Len(sVar2)).Font.Color = vbGreen

        bVar1 = False: bVar2 = False
    Next cl
End Sub

test

Answer 2

Change Format of Parts of Values in Cells

Links

Workbook Download

Image

The Code

'*******************************************************************************
Sub CFF(Range As Range, SearchString As String, _
        Optional ColorIndex As Long = -4105, _
        Optional OccurrenceFirst0All1 As Long = 1, _
        Optional Case1In0Sensitive As Long = 1)

    ' ColorIndex
    '    3 for Red
    '   10 for Green
    ' OccurrenceFirst0All1
    '   0 - Only First Occurrence of SearchString in cell of Range.
    '   1 (Default) - All occurrences of SearchString in cell of Range.
    ' Case1In0Sensitive
    '   0 - Case-sensitive i.e. aaa <> AaA <> AAA
    '   1 (Default) - Case-INsensitive i.e. aaa = AaA = AAA

    Const cBold As Boolean = False  ' Enable Bold (True) for ColorIndex <> -4105

    Dim i As Long         ' Row Counter
    Dim j As Long         ' Column Counter
    Dim rngCell As Range  ' Current Cell Range
    Dim lngStart As Long  ' Current Start Position
    Dim lngChars As Long  ' Number of characters (Length) of SearchString

    ' Assign Length of SearchString to variable.
    lngChars = Len(SearchString)

    ' In Range.
    With Range
        ' Loop through rows of Range.
        For i = .Row To .Row + .Rows.Count - 1
            ' Loop through columns of Range.
            For j = .Column To .Column + .Columns.Count - 1
                ' Assign current cell range to variable.
                Set rngCell = .Cells(i, j)
                ' Calculate the position of the first occurrence
                ' of SearchString in value of current cell range.
                lngStart = InStr(1, rngCell, SearchString, Case1In0Sensitive)
                If lngStart > 0 Then ' SearchString IS found.
                    If OccurrenceFirst0All1 = 0 Then ' FIRST occurrence only.
                        GoSub ChangeFontFormat
                      Else ' ALL occurrences.
                        Do
                            GoSub ChangeFontFormat
                            lngStart = lngStart + lngChars
                            lngStart = InStr(lngStart, rngCell, SearchString, _
                                    Case1In0Sensitive)
                        Loop Until lngStart = 0
                    End If
                  'Else ' SearchString NOT found.
                End If
            Next
        Next
    End With

Exit Sub

ChangeFontFormat:
    ' Font Formatting Options
    With rngCell.Characters(lngStart, lngChars).Font
        ' Change font color.
        .ColorIndex = ColorIndex
        ' Enable Bold for ColorIndex <> -4105
        If cBold Then
            If .ColorIndex = -4105 Then  ' -4105 = xlAutomatic
                .Bold = False
              Else
                .Bold = True
            End If
        End If
    End With
    Return

End Sub
'*******************************************************************************

Real Used Range (RUR)

'*******************************************************************************
' Purpose:    Returns the Real Used Range of a worksheet.
' Returns:    Range Object or "Nothing".
'*******************************************************************************
Function RUR(Optional NotActiveSheet As Worksheet) As Range

    Dim objWs As Worksheet

    If Not NotActiveSheet Is Nothing Then
        Set objWs = NotActiveSheet
    Else
        Set objWs = ActiveSheet
    End If

    If objWs Is Nothing Then Exit Function

    Dim HLP As Range   ' Cells Range
    Dim FUR As Long    ' First Used Row Number
    Dim FUC As Long    ' First Used Column Number
    Dim LUR As Long    ' Last Used Row Number
    Dim LUC As Long    ' Last Used Column Number

    With objWs.Cells
        Set HLP = .Cells(.Cells.Count)
        Set RUR = .Find("*", HLP, xlFormulas, xlWhole, xlByRows)
        If Not RUR Is Nothing Then
            FUR = RUR.Row
            FUC = .Find("*", HLP, , , xlByColumns).Column
            LUR = .Find("*", , , , xlByRows, xlPrevious).Row
            LUC = .Find("*", , , , xlByColumns, xlPrevious).Column
            Set RUR = .Cells(FUR, FUC) _
                    .Resize(LUR - FUR + 1, LUC - FUC + 1)
        End If
    End With

End Function
'*******************************************************************************

Usage

The following code if used with the Change1Reset0 argument set to 1, will change the format in each occurrence of the desired strings in a case-INsensitive search.

'*******************************************************************************
Sub ChangeStringFormat(Optional Change1Reset0 As Long = 0)

    Const cSheet As Variant = "Sheet1"
    Const cStringList As String = "WUG-FGT,INZL-DRE"
    Const cColorIndexList As String = "3,10"   ' 3-Red, 10-Green
    ' Note: More strings can be added to cStringList but then there have to be
    ' added more ColorIndex values to cColorIndexList i.e. the number of
    ' elements in cStringList has to be equal to the number of elements
    ' in cColorIndexList.

    Dim rng As Range      ' Range
    Dim vntS As Variant   ' String Array
    Dim vntC As Variant   ' Color IndexArray
    Dim i As Long         ' Array Elements Counter

    Set rng = RUR(ThisWorkbook.Worksheets(cSheet))

    If Not rng Is Nothing Then
        vntS = Split(cStringList, ",")
        If Change1Reset0 = 1 Then
            vntC = Split(cColorIndexList, ",")
            ' Loop through elements of String (ColorIndex) Array
            For i = 0 To UBound(vntS)
                ' Change Font Format.
                CFF rng, CStr(Trim(vntS(i))), CLng(Trim(vntC(i)))
            Next
          Else
            For i = 0 To UBound(vntS)
                ' Reset Font Format.
                CFF rng, CStr(Trim(vntS(i)))
            Next
        End If
    End If

End Sub
'*******************************************************************************

The previous codes should all be in a standard module e.g. Module1.

CommandButtons

The following code should be in the sheet window where the commandbuttons are created, e.g. Sheet1.

Option Explicit

Private Sub cmdChange_Click()
    ChangeStringFormat 1
End Sub

Private Sub cmdReset_Click()
    ChangeStringFormat ' or ChangeStringFormat 0
End Sub

Answer 3

Try:

Option Explicit

Sub test()

    Dim rng As Range, cell As Range
    Dim StartPosWUG As Long, StartPosINL As Long

    With ThisWorkbook.Worksheets("Sheet1")

        Set rng = .UsedRange

        For Each cell In rng

            StartPosWUG = InStr(1, cell, "WUG-FGT")
            StartPosINL = InStr(1, cell, "INZL-DRE")

            If StartPosWUG > 0 Then
                With cell.Characters(Start:=StartPosWUG, Length:=Len("WUG-FGT")).Font
                    .Color = vbRed
                End With
            End If

            If StartPosINL > 0 Then
                With cell.Characters(Start:=StartPosINL, Length:=Len("INZL-DRE")).Font
                    .Color = vbGreen
                End With
            End If

        Next

    End With

End Sub