View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
ryguy7272 ryguy7272 is offline
external usenet poster
 
Posts: 2,836
Default If Font.ColorIndex = 3, Copy Entire Row and Paste to New Sheet

Still stuck on a problem from a few days ago. I am trying to identify,
select, and copy all data in any row (copy the entire row) if a cells has any
red text in it. Then I want to move these items to a new sheet, lets call
it €śSummary Sheet€ť.
Earlier in the week, I was playing with two concepts; so far I have been
unable to get either one working. Id appreciate any help.

Concept#1
Sub Select_Red_Fonts()
Dim c As Range, SearchRange As Range, cell As Range, redFonts As Range, x
Set SearchRange = Cells.SpecialCells(xlCellTypeConstants)
For Each c In SearchRange
If cell.Font.ColorIndex = 3 Then
c.EntireRow.Select
If x = 1 Then
Set redFonts = Union(redFonts, cell)
Else
Set redFonts = cell
x = 1
End If
End If
Next c
c.EntireRow.Select
redFonts.Select

Worksheets.Add.Name = "Summary"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End Sub


Concept#2
Sub Select_Red_Fonts()
Dim c As Range, SearchRange As Range, cell As Range, redFonts As Range, x
Dim rw As Long
Set SearchRange = Cells.SpecialCells(xlCellTypeConstants)
For Each c In SearchRange
If cell.Font.ColorIndex = 3 Then
c.EntireRow.Select
Worksheets("Summary").Cells(rw, 1).Value = cell.Value
rw = rw + 1
End If
Next
End Sub

Thanks,
Ryan--



--
RyGuy