Conditional formatting with vba

[XR8 Sprintless]

I am a relative newbie at VBA and need some help with this one.
I have developed a sheet where I want to conditionally format the font
colour in cells in a row if the cell contents equals the contents in
column a.

I also need it to not change if the cell value is one of two values in
cell a of the row and finally if the values in the row do not equal the
value in column a then format the font in a different colour.

I have rows from 3 to 210 however I am not able to specify how many
columns need to be checked as that will vary.

EG

Column A Column B Column c ...

1 Apples Bananas(red font) Apples(blue font) Pears(red font)
apples(blue font)
2 Peaches Peaches(blue font) Apples(red font) Pears (red font) Peaches
(blue font)
3 TBP(No font change)
4 Bye(No font change)
..
..
210

I am trying to get it to work as a worksheet change event,however keep
getting nowhere. Can anyone help.

My thoughts were along the lines of

For x = 3 to 210
Select Case
Case TBP
if A(x) = "TBP"
No font change

Case Bye
If A(x) = "Bye"
No font change

Case CellEqual
If B(x).End(xlRight) = A(x)
Change font colour to blue

Case cellnotequal
If B(x).End(xlRight) <> A(x)
Change font colour to red

Next x

Can anyone help me to achieve this?

 

[Don Guillett]

Worksheet change events are meant to change that cell or another cell
when that cell is changed. You really don't want a loop firing each
time you make any change. If you desire is to match the last contigous
cell in the column and turn blue if so or red if not then this will do
it and color the cell in colum B when you change column B. Probably
not what you really want??


Private Sub Worksheet_Change(ByVal Target As Range)
Target.Font.ColorIndex = 5' red
If Target.Column = 2 And Target.End(xlToRight) = Target _
Then Target.Font.ColorIndex = 3'blue
End Sub

 

[XR8 Sprintless]

Worksheet change events are meant to change that cell or another cell
when that cell is changed. You really don't want a loop firing each
time you make any change. If you desire is to match the last contigous
cell in the column and turn blue if so or red if not then this will do
it and color the cell in colum B when you change column B. Probably
not what you really want??


Private Sub Worksheet_Change(ByVal Target As Range)
Target.Font.ColorIndex = 5' red
If Target.Column = 2 And Target.End(xlToRight) = Target _
Then Target.Font.ColorIndex = 3'blue
End Sub

Not exactly as I need. However I am thinking of another way I may be
able to get it to work.

 

[XR8 Sprintless]

Worksheet change events are meant to change that cell or another cell
when that cell is changed. You really don't want a loop firing each
time you make any change. If you desire is to match the last contigous
cell in the column and turn blue if so or red if not then this will do
it and color the cell in colum B when you change column B. Probably
not what you really want??


Private Sub Worksheet_Change(ByVal Target As Range)
Target.Font.ColorIndex = 5' red
If Target.Column = 2 And Target.End(xlToRight) = Target _
Then Target.Font.ColorIndex = 3'blue
End Sub

Hi Don

Thanks for this suggestion. I ended up getting it to work using a
combination of recording macros and rehashing some code I had already
used in the sheet.

Sub cond3()
'
' cond3 Macro
'

'
Range("ntipper").Select ,(I created a named range which can be
varied in size)
Range("ntipper").FormatConditions.Delete , Delete the current conditions


Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlNotEqual, _
Formula1:="=$A3"

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=$A3"

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=$A3=""bye"""

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ColorIndex = xlAutomatic
End With
Selection.FormatConditions(1).StopIfTrue = False

Selection.FormatConditions.Add Type:=xlExpression,
Formula1:="=$A3=""tbp"""

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ColorIndex = xlAutomatic
End With
Selection.FormatConditions(1).StopIfTrue = False


End Sub


Probably not the most elegant solution however it works.

This is part of the code which sets up the named range then calls the
cond3 macro to add the conditions once there are two columns added.

Dim W As Long
W = Sheets("Tables").Cells(88, "A").Value (this value is
incremented by one each time a new column is added to the workbook in
another section of the macro)
If [B215].Formula = "" Then
H(214).Activate
ActiveCell.Formula = "=COUNTIF(B$3:B$210,$A215)"
Selection.Copy
For x = 1 To 15
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ThisWorkbook.Names.Add Name:="tipper",
RefersTo:=Worksheets("TIPPING").Range("B3:B210")

Next x
ThisWorkbook.Names.Add Name:="ntipper",
RefersTo:=Range("tipper").Resize(, W)
Else
Range("b215").Select
Selection.Copy
H(214).Activate
ActiveSheet.Paste
Selection.Copy
For x = 1 To 15
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Next x
ThisWorkbook.Names.Add Name:="ntipper",
RefersTo:=Range("tipper").Resize(, W)
cond3
End If