R
ryguy7272
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, let’s 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. I’d 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--
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, let’s 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. I’d 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--