Excel macro: Change color of text within a ce

Microsoft Microsoft excel 2007 full vers...
March 3, 2010 at 10:49:11
Specs: Windows Vista
For example:

Range A1 thru A100 would contain single words in each cell, and any duplicates found in B1 thru B100 containing more than one word per cell, would have duplicates with another text color.

Is this possible without separating the multiple words within a cell, in order to find a match of a single word within a cell?


See More: Excel macro: Change color of text within a ce

Report •

#1
March 3, 2010 at 11:07:24
Hi,

I think that some more information is required.

In column B, cells B1 to B100, what are the duplicates -
is it a duplicate of a one of the words within the same cell,
or is it a duplicate of the contents of a cell in column B with another cell in column B, i.e., 2 cells in column B are identical,
or is it that a word in a cell in column B occurs in any cell in column A
or is it that a word in cell in column B is also present in the cell in the same row but in column A
or...
or is it something else.

Also you refer to duplicates with another text color. Will this be all the text in a duplicate cell or only a single word in a cell that has a different color.

Answering these question will help in possibly offering a solution.

Regards


Report •

#2
March 3, 2010 at 11:30:31
Column A will contain cells with single words in a range A1 thru A100 without duplicates.

Column B, in the range of B1 thru B100, will contain multiple words per cell, requiring change of text color.

Correct, my apologies in advance for any confusion.

Clarification: duplicates from column A, should change text color of similar words in column B. Column A will not have duplicates, column B will more than likely have duplicates. But only wish to compare column A, to column B (not to compare duplicates within column B itself).

Column A would have for example, single words within each cell:

For
Four
Fore

Column B may have multiple words within one cell, but within a range from B1 thru B100:

This one cell “for” example, may contain “four” or many words. “Fore” and aft.

Wish only the text, matching column A, to have a different text color in column B, of certain words defined by column A
as found within quotes in the above example.

Hope this makes a bit of sense.


Report •

#3
March 4, 2010 at 01:10:53
Try this code...

Note: There can not be any blank cells in A1:A100. If there are, we need to add a line to the skip empty cells.

Option Explicit
Sub ColorWord()
Dim A_row, B_row, A_len, chr_num
'Loop through A1:A100
 For A_row = 1 To 100
'Check B1:B100
  For B_row = 1 To 100
'Does B cell contain word from A cell?
   If Cells(B_row, 2) Like "*" & Cells(A_row, 1) & "*" Then
'Find length of word
    A_len = Len(Cells(A_row, 1))
'Loop through string in B to find word from A
     For chr_num = 1 To Len(Cells(B_row, 2)) - Len(Cells(A_row, 1)) + 1
      If Mid(Cells(B_row, 2), chr_num, A_len) = Cells(A_row, 1) Then
'When found, turn word Red
       Cells(B_row, 2).Characters(Start:=chr_num, Length:=A_len).Font.ColorIndex = 3
      End If
     Next
   End If
  Next
 Next
End Sub


Report •

Related Solutions

#4
March 4, 2010 at 05:26:42
Hi,

Here is another macro that colors matching words. In this case the matching word is given the same color as the matching word in column A. So set word colors in column A first.

This macro also adjust for the length of the lists.

The way that the macro finds the end of the lists in column A and column B requires that all cells below the last entry in both columns are empty.

The number of words per cell to be tested has been set to 10 (an arbitrary number - change intWds = 10 in the code as required.

To use this macro, on the worksheet with your lists of words create a command button.
These steps are for Excel 2007:
From the Ribbon select Developer (If it's not visible go to the Office Button, select Excel options at the bottom and select the Popular tab and check the 'Show Developer tab in the Ribbon' box)

In Developer - Controls select Insert and choose the button icon.
Draw the button on the worksheet
In the 'Assign Macro' dialog box select 'New'

In the code window that opens enter this:

Option Explicit
Sub Button1_Click()
Dim rngCellS As Range
Dim rngCellM As Range
Dim rngSingle As Range
Dim rngMult As Range
Dim intWds As Integer
Dim strChar As String
Dim varArry() As Variant
Dim l, m, n As Integer

On Error GoTo ErrHnd

'define range of single words in column A
Set rngSingle = Range("A1", Range("A" & CStr(Application.Rows.Count())).End(xlUp))

'define range of multiple words in column B
Set rngMult = Range("B1", Range("B" & CStr(Application.Rows.Count())).End(xlUp))

'set maximum number of words in multi-word cells in column B
intWds = 10

'size an array to hold the words
'element 0 = word, element 1 = start posn. element 2 = end posn.
ReDim varArry(rngMult.Cells.Count, intWds, 2)

'create array of single words in column B cells
'with start and end positions
'l counts cells
l = 0
For Each rngCellM In rngMult
    'm counts words
    m = 0
    'set start for first word
    varArry(l, 0, 1) = 1
    'n counts characters in cell text
    For n = 1 To Len(rngCellM.Text)
        strChar = Mid(rngCellM.Text, n, 1)
        If strChar <> " " Then
            varArry(l, m, 0) = varArry(l, m, 0) & strChar
            Else
            'save end of word position and set next start position
            varArry(l, m, 2) = n - 1
            varArry(l, m + 1, 1) = n + 1
            'next word position in array
            m = m + 1
        End If
    Next n
    'save last word end position
    varArry(l, m, 2) = n - 1
    'next cell
    l = l + 1
Next rngCellM

'loop through single words and find them in multiple words
For Each rngCellS In rngSingle
    'reset column B counter
    m = 0
    'loop through column B cells
    For Each rngCellM In rngMult
        For n = 0 To intWds
            'test each word
            If varArry(m, n, 0) = rngCellS.Text Then
                'if the words match then color the characters
                'the same as the single word
                rngCellM.Characters(varArry(m, n, 1), varArry(m, n, 2) - _
                    varArry(m, n, 1) + 1).Font.Color = rngCellS.Font.Color
            End If
        Next n
        'next cell
        m = m + 1
    Next rngCellM
Next rngCellS
Exit Sub

'error handler
ErrHnd:
Err.Clear
End Sub

Note that Sub Button1_Click() and End sub will already be present, so don't duplicate them. Option Explicit goes before Sub Button1_Click().

Click Save from the Visual Basic Menu.

Alt+f11 takes you back to the main Excel window.

Right click the button and Edit the name to something meaningful

After selecting any cell, the button should now respond to a click.

Note that the matching is case sensitive. To make it case insensitive add LCase to the match:

            'test each word
            If LCase(varArry(m, n, 0)) = rngCellS.Text Then
and have all words in column A lower case.

Regards


Report •

#5
March 4, 2010 at 07:29:05
DerbyDad03,

The output unfortunately changed all word color in column B, regardless of input in column A.

Column A contained:
test
testing
tests

Cell B1 text (all words were red):
one day I tested, testing, a test. Testing from tests, leaves a test.

Cell B2 text (all words were red):
testing, tested, tes, tset

Any ideas of how to fix would be appreciated!


Report •

#6
March 4, 2010 at 07:46:22
Humar,

The code has no affect upon the spreadsheet, yet throws no errors?

Any ideas?


Report •

#7
March 4, 2010 at 08:11:22
I'm assuming you didn't change the code to loop through only A1:A3.

As I said in my previous post, there can not be any blanks in A1:A100, which was the range you gave in your example. So if you ran it as is, the blanks below A3 would cause the problem that you described.

I have fixed the code to determine the actual length of the lists and to check for blanks to eliminate that issue.

However, based on your latest example, my code exhibits another problem:

It only finds the first occurrence of a given word in the string. For example, the first "testing" in B1 turned red, the second one didn't.

I need to work on that.


Report •

#8
March 4, 2010 at 08:35:32
DerbyDad03,

The modified code still turns all text in column B red.

Column A:
A1 test
A2 testing
A3 tests

Cell B1 (all red):
"I tested, with testing a test."

Would like text, rather string in one cell to have color changed. (IE: above example would change text color of the words test, testing, tests respectably, and not the words I, with, and a).

Am beginning to wonder if this presents an impasse to the limitations of excel?

Any thoughts are appreciated!


Report •

#9
March 4, 2010 at 09:07:27
Hi,

I assume you changed the font color of the words in column A.

This macro uses the colors of the listed words.

Regards


Report •

#10
March 4, 2010 at 09:53:50
re: The modified code still turns all text in column B red

Not on my spreadsheet.

With the code shown below, I get this result. I know it's not exactly what you want, but it's definitely not all red.

one day I tested, testing, a test. Testing from tests, leaves a test.
testing, tested, tes, tset

Option Explicit
Sub ColorWord()
Dim A_row, B_row, lstA_row, lstB_row, A_len, chr_num
'Find Last row of data in each list
lstA_row = Range("A" & Rows.Count).End(xlUp).Row
lstB_row = Range("B" & Rows.Count).End(xlUp).Row
'Loop through A1:A100
 For A_row = 1 To lstA_row
'Check B1:B100
  For B_row = 1 To lstB_row
'Does B cell contain word from A cell?
   If Cells(B_row, 2) Like "*" & Cells(A_row, 1) & "*" Then
'Find length of word
    A_len = Len(Cells(A_row, 1))
'Loop through string in B to find word from A
     For chr_num = 1 To Len(Cells(B_row, 2)) - Len(Cells(A_row, 1)) + 1
      If Mid(Cells(B_row, 2), chr_num, A_len) = Cells(A_row, 1) Then
'When found, turn word Red
       Cells(B_row, 2).Characters(Start:=chr_num, Length:=A_len).Font.ColorIndex = 3
      End If
     Next
   End If
  Next
 Next
End Sub


Report •

#11
March 4, 2010 at 12:13:59
DerbyDad03,

Correct, had thought by spaces, it referred to spaces between cells in column A, excluding end spaces. Thank you for insight of my oversight regarding placement of spaces.

Color of text in column A was certainly an oversight on my part as well, apologies in assuming text color was defined within the macro itself.

With apologies in order, allow me to say I AM ESTATIC! MSKB, and MS Office web sites have no information on how to perform this, nor do many VB, VBA scripting sites. I have looked for over two years in finding something to do this, and am highly grateful someone with the knowledge and experience took the time to make it happen.

Regarding same, would it pose difficultly for the change of text color in column B, to be of an exact match (IE: test will also change partial words like “test”ing)?

Additionally, if it would be of interest? Could the words with the changed text color, also be enclose with special characters such as (), rather (test) for example?

This does provide an immense help in its application, thank you!

Humar,

Attempted to change color of text in column A, hoping this may work as it did with the code provided by DerbyDad03.

Unfortunately with the same results as the first attempt.

I would like to express thanks regarding how to place a button to a macro inside of a sheet previously unbeknownst to me, thank you! As I previously used keyboard shortcuts for about ten or so regularly used macro’s within the same sheet that cannot be chained, or called from one macro, and am running out of keys, this will prove most useful in the future.


Report •

#12
March 4, 2010 at 13:31:13
Hi,

If it would be of any value, I don't mind sending you the working example spreadsheet, complete with button!

If you do want it, please send me a private message with an e-mail address.

Regards


Report •

#13
March 5, 2010 at 06:14:37
Humar,

Sent the email via PM.

DerbyDad03,

Without sounding silly, what lines need modified to read from sheet 2, column A? (Instead of sheet1, column A).

I can do it, simply not sure what is the correct syntax.

Thanks in advance!

FYI: If using a paste link, into another sheet, or workbook, running the macro also has no affect upon text. (IE: The reason for the last question regarding change of sheets within the vb script).


Report •

#14
March 5, 2010 at 06:55:42
Humar,

That did the trick, appreciate it much.

Wonder why it did not work for me? Suppose it was operator error.

Many thanks.


Report •

#15
March 5, 2010 at 09:55:28
Actually, my code works on the ActiveSheet, not any specific sheet.

If you want to reference specific sheets, you would put:

Sheets(something)

before each reference to a Range or Cells.

Sheets(1), Sheets(2), etc.
Sheets("My Sheet Name"), Sheets("My Other Sheet Name"), etc.

Specific to your question, the changes would be to:

lstA_row =  Sheets(2).Range("A" & Rows.Count).End(xlUp).Row

and everywhere you see:

Cells(A_row, 1)

should become:

Sheets(2).Cells(A_row, 1)

The same concept can be applied to the references to Column B so that the code will always refer to specific sheets regardless if which sheet is active when you run the code.


Report •

#16
March 5, 2010 at 17:49:19
The help is appreciated, and both script code’s seem very clean and well commented.

Thanks again!


Report •

#17
March 6, 2010 at 04:54:23
Hi,

Glad to have been able to help, and thanks for the feedback.

Regards

Humar


Report •

Ask Question