Hi,

I have code which copies rows to a new sheet based on certain criteria.

Dim SearchRange As Range
Dim EachCell As Range
Dim CopyRange As Range
Dim nSh As Worksheet
Dim LastRow As Long



Application.ScreenUpdating = False
Columns("N:N").Hidden = False

'Set SearchRange = ActiveSheet.Range("C1:Q5000")
LastRow = Cells(Rows.Count, "F").End(xlUp).Row
Set SearchRange = ActiveSheet.Range("C1:Q" & LastRow)

For Each EachCell In SearchRange
If EachCell.Font.ColorIndex = 3 Or EachCell.Interior.ColorIndex
= 3 _
Or EachCell.Font.Bold Or EachCell.Interior.ColorIndex = 6 _
Or EachCell.Font.Color < vbBlack Or
EachCell.Interior.ColorIndex = 8 _
Or EachCell.Interior.ColorIndex = 33 Then
'Or EachCell.Font.ColorIndex = "Custom color or no fill" Then
If Not CopyRange Is Nothing Then
Set CopyRange = Union(CopyRange, EachCell.EntireRow)
Else
Set CopyRange = EachCell.EntireRow
End If
End If
Next EachCell
CopyRange.Copy
Set nSh = Worksheets.Add
nSh.Range("A1").PasteSpecial xlPasteAll
Columns("A:o").Select
Columns("A:o").EntireColumn.AutoFit
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 8
End With

I would like to also copy the row if only certain characters or words are
red as opposed to the entire cell containing red font. Some of the words may
be black and red within one cell.

If some could please assist I surely would appreciate it.
--
By persisting in your path, though you forfeit the little, you gain the
great.