Automatically partial text Coloring in Excel(NOT CELLS)

Question

I am newbie at excel and VBA so I came here to ask for your help.
I am looking for a VBA code to automatically color the first letter of each column cell.

This is expected for column A only, not all columns in excel. There are only words in the column.

For example, if the first letter is 'a' then the 'a' only will become red.
There is no limit of case-sensitive and each of a-z will be colored in 26 distinguishable colors.
I tried for a couple of days to find a solution, but unfortunately I couldn't.

Demonstration:

Thanks in advance.

https://stackoverflow.com/questions/7618121/change-color-of-certain-characters-in-a-cell — braX, Dec 26 '20 at 12:54

score 1 · Accepted Answer · answered Dec 28 '20 at 04:14

There’s (at least) a couple of ways to do this. The first option below selects the color for you – you don’t get a choice, but the code is much shorter. The second option will require you to hard code the actual color you want for each letter – I’ve only gone as far as C for the sake of demonstration.

In both cases, you paste the code into the Sheet module area for the appropriate sheet. Let me know how it goes for you. I've taken this approach because you said you wanted it to occur "automatically"

Option One – shorter but no choice of color

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo GetOut
Application.EnableEvents = False
Dim myFont As Integer, aCell As Range

For Each aCell In Target.Cells
    myFont = Asc(UCase(Left(aCell, 1))) - 62
    aCell.Characters(Start:=1, Length:=1).Font.ColorIndex = myFont
Next

Continue:
    Application.EnableEvents = True
    Exit Sub
GetOut:
    MsgBox Err.Description
    Resume Continue    
End Sub

Option Two – you choose the color you want, but must be added

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo GetOut
Application.EnableEvents = False
Dim myLetter As String, aCell As Range

For Each aCell In Target.Cells    
    myLetter = UCase(Left(aCell, 1))

        Select Case myLetter
            Case Is = "A"
                aCell.Characters(Start:=1, Length:=1).Font.ColorIndex = 3 `<~~ change to your taste
            Case Is = "B"
                aCell.Characters(Start:=1, Length:=1).Font.ColorIndex = 4
            Case Is = "C"
                aCell.Characters(Start:=1, Length:=1).Font.ColorIndex = 5
    
            '*** etc etc etc Add the rest of the alphabet***
        End Select  
Next

Continue:
    Application.EnableEvents = True
    Exit Sub
GetOut:
    MsgBox Err.Description
    Resume Continue
End Sub

score 1 · Answer 2 · answered Dec 28 '20 at 04:53

To apply this to any (or certian) worksheets in the Workbook containing the code, place this code in the ThisWorkbook module

Option Explicit

Private Colours As Variant

' Define Colour Pallete
Private Sub PopulateColours()
    ReDim Colours(0 To 25)
    
    Colours(0) = vbRed 'A
    Colours(1) = vbBlue 'B
    ' etc C..Z
    
End Sub

' Colour first character of each non-formula cell in range
Private Sub ColourCells(rng As Range)
    Dim cl As Range
    
    ' if pallet not set, initialise it
    If IsEmpty(Colours) Then PopulateColours
    ' loop the range
    For Each cl In rng
        ' ignore formula, numeric and empty cells
        If Not IsEmpty(cl) Then
            If Not cl.HasFormula Then
                If Not IsNumeric(cl.Value2) Then
                    If Not cl.Value2 = "" Then
                        With cl.Characters(1, 1)
                            .Font.Color = Colours(Asc(UCase(.Text)) - 65)
                        End With
                    End If
                End If
            End If
        End If
    Next
End Sub

' when and cell on any worksheet in the workbook changes...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    ' select specific sheets to apply colour to
    Select Case Sh.Name
        Case "Sheet1", "Sheet2"
            ' only colour column A
            If Not Application.Intersect(Target, Sh.Columns(1)) Is Nothing Then
                ' call colouring routine
                ColourCells Target.Columns(1)
            End If
    End Select
End Sub

If you want to apply this to any (or certain) open workbooks, you'll need an Application Events handler

Automatically partial text Coloring in Excel(NOT CELLS)

2 Answers2