Filehost.ro - gazduire fisiere
Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
Nou pe simpatie:
Ioanacatalina
Femeie
25 ani
Salaj
cauta Barbat
25 - 61 ani
Mrrrr's Forum (VIEW ONLY)ReguliInregistrareLoginPozeNu sunteti logat. Lista Forumurilor Pe Tematici
Mrrrr's Forum (VIEW ONLY) / Tutoriale si Ghiduri Utile // Tutorials and useful guides /

[EXCEL] Color Text Inside Cell

Pagini: 1 Moderat de TRaP, TonyTzu
#1
TRaP
Moderator
Postari: 960
Source (was for making text CAPS LOCK, but also some code that was inserting some text then coloring it):
https://www.mrexcel.com/forum/excel-que ... e-vba.html

I adapted the code from source only to color the desired text in red.
It has to be done like it's explained below because VBA code can't be run when Excel is in edit mode (eg inside a cell and/or with a part of text selected).

How it works:

Select the cell (not the text you want in red, the entire cell), press the button in QAT or keyboard shortcut you assigned to the following code. An InputBox appears that contains the whole text inside the cell.

You must delete the text that you don't want to change color of and leave there only the text that you want to be blue, then press OK.

The code below works for only 1 cell at a time, not for a range of cells.


Sub ColorTextInsideCell()

Dim cell_text As String
Dim txt As String, CSorCI As String
Dim n As Long
Dim cnt As Integer
Dim i As Long

    cell_text = ActiveCell.Value
   
    txt = InputBox("Leave only words you want to color", "Characters...", cell_text)
    If txt = "" Then Exit Sub
   
    CSorCI = InputBox("Type CS or CI, no spaces", "Case sensitive or iNSENSiTiVE", "CS / CI")
   
' CASE SENSITIVE
If CSorCI = "CS" Then
    cnt = (Len(cell_text) - Len(Replace(cell_text, txt, ""))) / Len(txt)
    For i = 1 To cnt
        n = InStr(n + i, cell_text, txt)
        ActiveCell.Characters(Start:=n, Length:=Len(txt)).Font.ColorIndex = 5 ' blue
    Next i

Else

' CasE iNSENSiTiVE
    If CSorCI = "CI" Then
        cnt = (Len(cell_text) - Len(Replace(LCase(cell_text), LCase(txt), ""))) / Len(txt)
        For i = 1 To cnt
            n = InStr(n + i, cell_text, txt, vbTextCompare)
            ActiveCell.Characters(Start:=n, Length:=Len(txt)).Font.ColorIndex = 5 ' blue
        Next i

' other text typed in 2nd InputBox besides CS or CI   
    Else: Exit Sub
    End If
End If

End Sub


 
   
#2
TRaP
Moderator
Postari: 960
TBA:
- make UserForm to be able to select the desired text color
- add more colors
- add options for UPPERCASE, lowercase, Title Case, Sentence case
- add options for bold, underline, italic, strike-through


 
   
#3
TRaP
Moderator
Postari: 960
TBA:
- add option for a range of cells instead of just 1 cell


 
   
#4
TRaP
Moderator
Postari: 960
Format for multiple rows:

Source:
https://www.excel-pratique.com/en/vba_t ... _in_a_cell

Example data:

1. Paris 2220000
2. Marseilles 324000
3. Lyon 250000

In this example, the macro will return the first 2-3 characters in italics and the name of the city or town in bold:


Sub FormatTextInCell()

    For row_num = 1 To 12
   
        'Cell contents
        cell_text = Cells(row_num, 1)
       
        'Same contents split into three parts and saved in an array
        text_array = Split(cell_text, " ")
       
        'Length of part 1
        length_1 = Len(text_array(0))
       
        'Length of part 2
        length_2 = Len(text_array(1))
       
        'Set ITALICS for Part 1
        Cells(row_num, 1).Characters(1, length_1).Font.Italic = True
       
        'Set BOLD for Part 2
        Cells(row_num, 1).Characters(length_1 + 2, length_2).Font.Bold = True

    Next

End Sub


 
   
#5
Mrrrr
AdMiN
Postari: 2388
Improved and replaced code in the post above to be case sensitive or case insensitive and to count all occurrences.

_______________________________________


 
   
Pagini: 1  
Mergi la