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.
Lista Forumurilor Pe Tematici
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login

POZE MRRRR'S FORUM (VIEW ONLY)

Nu sunteti logat.
Nou pe simpatie:
GeorgianaBC pe Simpatie
Femeie
23 ani
Bacau
cauta Barbat
28 - 80 ani
Mrrrr's Forum (VIEW ONLY) / Tutoriale si Ghiduri Utile // Tutorials and useful guides / [EXCEL] Color Text Inside Cell Moderat de TRaP, TonyTzu
Autor
Mesaj Pagini: 1
TRaP
Moderator

Inregistrat: acum 6 ani
Postari: 748
Source (was for making text CAPS LOCK, but also some code that was inserting some text then coloring it):

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


Modificat de TRaP (acum 5 ani)


pus acum 5 ani
   
TRaP
Moderator

Inregistrat: acum 6 ani
Postari: 748
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


Modificat de TRaP (acum 5 ani)


pus acum 5 ani
   
TRaP
Moderator

Inregistrat: acum 6 ani
Postari: 748
TBA:
- add option for a range of cells instead of just 1 cell


pus acum 4 ani
   
TRaP
Moderator

Inregistrat: acum 6 ani
Postari: 748
Format for multiple rows:

Source:

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


Modificat de TRaP (acum 4 ani)


pus acum 4 ani
   
Mrrrr
AdMiN

Inregistrat: acum 17 ani
Postari: 2186
Improved and replaced code in the post above to be case sensitive or case insensitive and to count all occurrences.

_______________________________________


pus acum 4 ani
   
Pagini: 1  

Mergi la