PDA

View Full Version : Solved: conditional formatting by color



sasa
05-10-2008, 07:29 AM
Excel 2007 let me change the color of an item in a cell. If I state if word in a1 = Tom than the font = red, every time I write Tom, it appears red coloured.
But I have a more complex need. Infact I have in the same cell more words (for example: Tom, Jack, Ann, etc) an I need to color every name of a different color the way I can easily distinguish every name from the one quickly. Is there a way to do so ?

I appreciate any help

sasa

Bob Phillips
05-10-2008, 12:20 PM
In 2007, you multiple conditions, so just keep adding to them.

sasa
05-10-2008, 09:39 PM
You are right, but the multiple formatting option works only if the names are in different cells ( one name, one cell) but I have many names in the same cell (for example a1= jack tom arthur
b1= ralph annie gregory and so on and I need to color each name differently.

With regards


sasa

Bob Phillips
05-11-2008, 01:48 AM
Then you need VBA to parse it, pick out the names and colour accordingly.

Why not just split it into individual cells?

sasa
05-11-2008, 06:46 AM
Can u help me, with VBA code. I am a newbie. so I am not able to this.
About the split way I tried this , but the my names for one cell are a lot so finally I have a lot of splitted columns, and the look of the sheet is
awful and even more difficult is to read it quickly.

Bob Phillips
05-11-2008, 07:23 AM
Here's some code that works on the active cell



Dim aryNames As Variant
Dim i As Long
Dim ci As Long
Dim pos As Long

aryNames = Split(ActiveCell.Value, " ")

For i = LBound(aryNames) To UBound(aryNames)

Select Case aryNames(i)

Case "Alan": ci = 3
Case "Bob": ci = 5
Case "Jim": ci = 6
Case "Joe": ci = 7
Case "Mike": ci = 10
Case Else: ci = 0
End Select

If ci > 0 Then

pos = InStr(ActiveCell.Value, aryNames(i))
If pos > 0 Then

ActiveCell.Characters(pos, Len(aryNames(i))).Font.ColorIndex = ci
End If
End If
Next i

sasa
05-11-2008, 09:12 PM
Thank you a lot. It is perfect. I have to work on a long column, can you help me doing this last passage.

sasa

Bob Phillips
05-12-2008, 12:27 AM
Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long, j As Long
Dim iLastRow As Long
Dim aryNames As Variant
Dim ci As Long
Dim pos As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To iLastRow 'iLastRow to 1 Step -1

aryNames = Split(.Cells(i, TEST_COLUMN).Value, " ")

For j = LBound(aryNames) To UBound(aryNames)

Select Case aryNames(j)

Case "Alan": ci = 3
Case "Bob": ci = 5
Case "Jim": ci = 6
Case "Joe": ci = 7
Case "Mike": ci = 10
Case Else: ci = 0
End Select

If ci > 0 Then

pos = InStr(.Cells(i, TEST_COLUMN).Value, aryNames(j))
If pos > 0 Then

.Cells(i, TEST_COLUMN).Characters(pos, Len(aryNames(j))).Font.ColorIndex = ci
End If
End If
Next j
Next i

End With

End Sub

sasa
05-12-2008, 06:06 AM
Thank you. Your help allow me to spare a lot of time, thanks again.

sasa