Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy rows where cells contain red and black font.
Hello,
Fortunately I've been able to get a lot of support which has helped me from this group. Currently I have a problem copying rows where there may be a combination of font colors. I use the following code to copy red text only. I'm still learning about vba and I find it absolutely amazing. I think you experts really display expertise in assisting beginners like me. Now I would appreciate any assistance for copying rows whereas cells having a combination of red and black text. Any assistance you provide will be greatly appreciated. Sub CopyRowsWithRed() Dim SearchRange As Range Dim EachCell As Range Dim CopyRange As Range Dim nSh As Worksheet Application.ScreenUpdating = False Set SearchRange = ActiveSheet.Range("C1:Q5000") For Each EachCell In SearchRange If EachCell.Font.ColorIndex = 3 Or EachCell.Interior.ColorIndex = 6 _ Or EachCell.Font.Bold 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 Range("A1").Select With ActiveSheet.PageSetup .PrintTitleRows = "$1:$1" .Orientation = xlLandscape .PrintGridlines = True .PrintTitleColumns = "" .LeftMargin = Application.InchesToPoints(0.25) .RightMargin = Application.InchesToPoints(0.25) .TopMargin = Application.InchesToPoints(1) .BottomMargin = Application.InchesToPoints(0.75) .HeaderMargin = Application.InchesToPoints(0.5) .FooterMargin = Application.InchesToPoints(0.5) .LeftFooter = "FOUO" .CenterHeader = "CRRRENT UPDATES" .RightHeader = "&D" Columns("A:A").ColumnWidth = 4.71 Columns("B:B").ColumnWidth = 3.86 Columns("C:C").ColumnWidth = 4.01 Columns("D:D").ColumnWidth = 4.86 Columns("E:E").ColumnWidth = 4.86 Columns("F:F").ColumnWidth = 12.57 Columns("G:G").ColumnWidth = 18.29 Columns("H:H").ColumnWidth = 9.29 Columns("I:I").ColumnWidth = 8.43 Columns("J:J").ColumnWidth = 8.43 Columns("K:K").ColumnWidth = 8.43 Columns("L:L").ColumnWidth = 4.29 Columns("M:M").ColumnWidth = 4.57 Columns("N:N").ColumnWidth = 5.29 Columns("O:O").ColumnWidth = 5.86 Columns("P:P").ColumnWidth = 16.86 End With Columns("G:G").Select With Selection .WrapText = True End With Range("P1").Select Application.ScreenUpdating = True Columns("Q:Q").ColumnWidth = 11.29 End Sub -- By persisting in your path, though you forfeit the little, you gain the great. |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Delete text when font is color black | Excel Programming | |||
Usedrange copy- paste : Blank rows filled in black color | Excel Programming | |||
Count a Range, but only those cells with Black font Q | Excel Worksheet Functions | |||
Setting of input cells as blue font and formula cells as black fon | Excel Discussion (Misc queries) | |||
getting font color to stay black! | Excel Discussion (Misc queries) |