Conditional formatting VBA

[Lenna]

I've recorded a macro that highlights cells in row Q if they contain a word "donor" or "Transplant" and the code is too long. Can the same be accomplished with less code?

Please propose something better.

Thanks,

Lenna

Columns("Q:Q").Select ‘highlights all cell that contain “donor”
Selection.FormatConditions.Add Type:=xlTextString, String:="Donor", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False ‘highlight al cell that contain “transplant”
Selection.FormatConditions.Add Type:=xlTextString, String:="Transplant", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("Q20").Select
Cells.FormatConditions.Delete
Columns("Q:Q").Select
Range("Q20").Activate
Selection.FormatConditions.Add Type:=xlTextString, String:="Donor", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Columns("Q:Q").Select
'find donor

Columns("Q:Q").Select
Selection.Find(What:="Donor", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select

Selection.FormatConditions.Add Type:=xlTextString, String:="Transplant", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Columns("Q:Q").Select

 

[sastoka]

Hi there,

Try this

Sub Find_And_Highlight()

Dim r As Range
Dim Lastrow As Long

Lastrow = Cells(Rows.Count, "Q").End(xlUp).Row

For Each r In Range("Q1:Q" & Lastrow)

    If r.Value = "Donor" Then r.Interior.Color = 65535
    If r.Value = "Transplant" Then r.Interior.Color = 65535

Next r

End Sub

b

I DIDN'T TEST IT SO TRY IT IN A COPY OF YOUR WORKBOOK PLEASE.

Regards,