Column with same characters as Col1 to be in color

Dalia123

New Member
Joined
Nov 29, 2005
Messages
20
I am trying to make something like a small kids dictionary file in my native language.

One column has a specific word 'example PLAY' the next column has different forms of the same characters. say 'PLAY ground'. I need the second column which has the word 'PLAY ground' to color the characters (i.e. not the whole word as a unit. but individual characters included in col1 word, and included in the second column.

example in the below (i.e. the caps in the second column should be in color say red)

col1 col2
PLAY PLAYground
PLAY PLAY boY

can u help me?
[/img]
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
2,226
Hum, interesting.
You will have a list of Words (1 or more words per cell?) in col.1 and list of Phrases in col.2; right?

Would you like having the color effect on the "currently selected row" or on all the Phrases in col.2?

Let me know, bye.
 

Dalia123

New Member
Joined
Nov 29, 2005
Messages
20
I want the color effect only in column 2 in the same raw.

example

col1 col2
row1 GIRL fGsRR
row2 TWO grTiO
 

yee388

Well-known Member
Joined
Mar 7, 2004
Messages
1,374
To the extent of my knowledge, it is not possible to automatically change the color of a portion of a cell.
 

pgc01

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,884

ADVERTISEMENT

Hi Dalia123

This is an example of a simple code that does what you want.

In this example I considered that the words are in column A and the sentences that includes the word (even as part of another word like in PLAYground) are in column B.

The words will be coloured in red in column B.

Hope this gets you started
PGC


Code:
Option Compare Text

Sub ColourHighlightText()
Dim rR As Range, rC As Range, vPos

Set rR = Range("A1", Range("A" & Rows.Count).End(xlUp))
For Each rC In rR
    vPos = InStr(rC.Offset(0, 1), rC)
    If vPos > 0 Then
        rC.Offset(0, 1).Characters(vPos, Len(rC)).Font.ColorIndex = 3
    End If
Next
End Sub
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi,

you can have different fonts, colors, sizes, ... in one cell
type abc123abc in a cell
select "123"
do some formatedits
enter
:)

this code will check all items in column A and find them anywhere on the sheet (except column A of course)
to have the desired effect you can
OR
give all items another fontcolor
OR
enable the line
.ColorIndex = 3 (disable the other)
Code:
Option Explicit

Sub color_words_according_to_list()
'Erik Van Geit
'060905
'column A has items to find in MatchRng
'all occurencies of those items are colored
'same fontcolor as items

'EXAMPLE
'LIST       MatchRng (may be more columns)
'PLAY       PLAY this game
'SCHOOL     please don't read
'BOY        are you going to school or not
'GIRL       who's this little boy
'           are you a girl
'           have a PLAY with this
'           who's PLAYing in school
'           you can find here boys and girls
'RESULT
'"play" font = red
'"school" font = green
'all occurencies of "play" will be red (see uppercase)
'different items in same cells of MatchRng will be colored
'who's PLAY(red)ing in SCHOOL(green) ?

Dim CheckList As Range
Dim CheckCell As Range
Dim CheckText As String
Dim MatchRng As Range   'to find in this range
Dim MatchCell As Range
Dim LR As Long          'Last Row
Dim LC As Integer       'Last Column
Dim FA As String        'First Adress

LR = Cells(Rows.Count, 1).End(xlUp).Row
Set CheckList = Range("A1:A" & LR)
LR = Cells.Find("*", [A1], xlFormulas, xlPart, xlByRows, xlPrevious, False, False).Row
LC = Cells.Find("*", [A1], xlFormulas, xlPart, xlByColumns, xlPrevious, False, False).Column
Set MatchRng = Range(Range("B1"), Cells(LR, LC))


    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    End With

    With MatchRng
        For Each CheckCell In CheckList
        CheckText = CheckCell.Value
            If CheckText <> "" Then
            Set MatchCell = .Find(CheckText, .Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlPrevious, False, False)
                If Not MatchCell Is Nothing Then
                FA = MatchCell.Address
                    Do
                    Call color_word(MatchCell, CheckText, CheckCell.Font.ColorIndex)
                    Set MatchCell = .FindNext(MatchCell)
                    Loop While Not MatchCell Is Nothing And MatchCell.Address <> FA
                End If
            End If
        Next CheckCell
    End With

    With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    End With
End Sub

Sub color_word(C As Range, txt As String, col As Integer)
    With C.Characters(InStr(1, LCase(C), LCase(txt)), Len(txt)).Font
        'color according to fontcolor of item to find
        .ColorIndex = col
        'or a "fixed" color if you want
        '.ColorIndex = 3
        .Bold = True
    End With
End Sub
  A      B                                
1 PLAY   play this game                   
2 SCHOOL please don't read                
3 BOY    are you going to school or not ? 
4 GIRL   who's this little boy            
5        are you a girl                   
6        have a play with this            
7        who's playing in school ?        
8        you can find here boys and girl

Blad1

[Table-It] version 05 by Erik Van Geit

perhaps a bit more than what you asked :)

kind regards,
Erik

EDIT: added "Ad Integer" on line
Sub color_word(C As Range, txt As String, col As Integer)
 

Dalia123

New Member
Joined
Nov 29, 2005
Messages
20

ADVERTISEMENT

worked only in special cases as in the examples below
ABC ABC ===>only correct row
ABC ABCd===>only correct row
ABC afbfcf (did not work in this row
ABCD abc (did not work)
 

Dalia123

New Member
Joined
Nov 29, 2005
Messages
20
Erik,

Your code can help me. But it's not exactly what I want.

I need it to search the chracters in col1/rowX and highlight similar characters (not words) in col2/rowX

example
Col1 Col2
ABC kAfBsau
DEF abcEu
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Erik,

Your code can help me. But it's not exactly what I want.

I need it to search the chracters in col1/rowX and highlight similar characters (not words) in col2/rowX

example
Col1 Col2
ABC kAfBsau
DEF abcEu
my code is not helpful for you, but we will produce something else ...
anyway you can see the "characters"-trick and play with it
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
try this
Code:
Option Explicit

Sub test()
'Erik Van Geit
'060905

Dim LR As Long
Dim i As Long
Dim j As Integer
Dim CheckText As String
LR = Cells(Rows.Count, 1).End(xlUp).Row


    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    End With
    
    For i = 1 To LR
    CheckText = LCase(Cells(i, 1))
        With Cells(i, 2)
            For j = 1 To Len(.Value)
            If InStr(1, CheckText, LCase(Mid(.Value, j, 1))) > 0 Then Call color_word(Cells(i, 2), j)
            Next j
        End With
    Next i
    
    With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    End With
End Sub

Sub color_word(C As Range, j As Integer)
    With C.Characters(j, 1).Font
        .ColorIndex = 3
        '.Bold = True
    End With
End Sub

EDIT: changed macroname to "test"
 

Forum statistics

Threads
1,141,019
Messages
5,703,763
Members
421,315
Latest member
awaisnazir139

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top