Conditional formatting for part of a cell

M

Marie Bayes

Hi
I wondered if any of you fantastic VB coders have a piece of code I can try
for the following: I would like to replace the formatting for part of a
cell, eg, I may have the following text in a cell "Me vs You" and for every
instance of Me I need to change the colour and/or font size, however, using
Find and Replace replaces the formatting for the whole of the cell, not just
the instance of the word I'm trying to change.
Does anyone know how to do this?
 
B

Bob Phillips

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "H1:H10" '<=== change to suit
Dim iPos As Long

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
.Font.ColorIndex = xlColorIndexAutomatic
iPos = InStr(.Value, "Me")
If iPos > 0 Then
.Characters(iPos, 2).Font.ColorIndex = 3
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.




--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
D

Dave F

Google Excel color index.

I know there are a bunch of web pages devoted to this topic.

Dave
 
M

Marie Bayes

Is there a way that I can get this to work for multiples, eg, in the same
range I need to change the format of lots of different words within lots of
different cells. I tried adding, ELSE blah blah, but that didn't seem to
work....
 
B

Bob Phillips

Option Explicit

Public Enum xlColorIndex
xlCIBlack = 1
xlCIWhite = 2
xlCIRed = 3
xlCIBrightGreen = 4
xlCIBlue = 5
xlCIYellow = 6
xlCIPink = 7
xlCITurquoise = 8
xlCIDarkRed = 9
xlCIGreen = 10
xlCIDarkBlue = 11
xlCIDarkYellow = 12
xlCIViolet = 13
xlCITeal = 14
xlCIGray25 = 15
xlCIGray50 = 16
xlCIPeriwinkle = 17
xlCIPlum = 18
xlCIIvory = 19
xlCILightTurquoise = 20
xlCIDarkPurple = 21
xlCICoral = 22
xlCIOceanBlue = 23
xlCIIceBlue = 24
'xlCIDarkBlue = 25
'xlCIPink = 26
'xlCIYellow = 27
'xlCITurquoise = 28
'xlCIViolet = 29
'xlCIDarkRed = 30
'xlCITeal = 31
'xlCIBlue = 32
xlCISkyBlue = 33
xlCILightGreen = 35
xlCILightYellow = 36
xlCIPaleBlue = 37
xlCIRose = 38
xlCILavender = 39
xlCITan = 40
xlCILightBlue = 41
xlCIAqua = 42
xlCILime = 43
xlCIGold = 44
xlCILightOrange = 45
xlCIOrange = 46
xlCIBlueGray = 47
xlCIGray40 = 48
xlCIDarkTeal = 49
xlCISeaGreen = 50
xlCIDarkGreen = 51
xlCIBrown = 53
xlCIIndigo = 55
xlCIGray80 = 56
End Enum


Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "H1:H10" '<=== change to suit
Dim iPos As Long

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
.Font.ColorIndex = xlColorIndexAutomatic
Select Case True
Case InStr(.Value, "Me") > 0:
.Characters(InStr(.Value, "Me"), 2).Font.ColorIndex =
xlCIRed
Case InStr(.Value, "You") > 0:
.Characters(InStr(.Value, "You"), 2).Font.ColorIndex =
xlCIBlue
Case InStr(.Value, "Us") > 0:
.Characters(InStr(.Value, "Us"), 2).Font.ColorIndex =
xlCIGreen
Case Else:
.Font.ColorIndex = xlColorIndexAutomatic
End Select
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub


'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.





--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
B

Bob Phillips

Public Enum xlColorIndex
xlCIBlack = 1
xlCIWhite = 2
xlCIRed = 3
xlCIBrightGreen = 4
xlCIBlue = 5
xlCIYellow = 6
xlCIPink = 7
xlCITurquoise = 8
xlCIDarkRed = 9
xlCIGreen = 10
xlCIDarkBlue = 11
xlCIDarkYellow = 12
xlCIViolet = 13
xlCITeal = 14
xlCIGray25 = 15
xlCIGray50 = 16
xlCIPeriwinkle = 17
xlCIPlum = 18
xlCIIvory = 19
xlCILightTurquoise = 20
xlCIDarkPurple = 21
xlCICoral = 22
xlCIOceanBlue = 23
xlCIIceBlue = 24
'xlCIDarkBlue = 25
'xlCIPink = 26
'xlCIYellow = 27
'xlCITurquoise = 28
'xlCIViolet = 29
'xlCIDarkRed = 30
'xlCITeal = 31
'xlCIBlue = 32
xlCISkyBlue = 33
xlCILightGreen = 35
xlCILightYellow = 36
xlCIPaleBlue = 37
xlCIRose = 38
xlCILavender = 39
xlCITan = 40
xlCILightBlue = 41
xlCIAqua = 42
xlCILime = 43
xlCIGold = 44
xlCILightOrange = 45
xlCIOrange = 46
xlCIBlueGray = 47
xlCIGray40 = 48
xlCIDarkTeal = 49
xlCISeaGreen = 50
xlCIDarkGreen = 51
xlCIBrown = 53
xlCIIndigo = 55
xlCIGray80 = 56
End Enum


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
G

Gord Dibben

Marie

To get the colors and indexes, run this macro.

Sub ListColorIndexes()
Dim Ndx As Long
Sheets.Add
For Ndx = 1 To 56
Cells(Ndx, 1).Interior.ColorIndex = Ndx
Cells(Ndx, 2).Value = Hex(ThisWorkbook.Colors(Ndx))
Cells(Ndx, 3).Value = Ndx
Next Ndx
End Sub


Gord Dibben MS Excel MVP
 
Top