| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Simplify code copy based on condition
Hello,
I would like help modifying my code for copying rows with certain conditions to a new sheet. I currently have code with a range extending to 5000 but the rows may vary from day to day. I like to it to look at the last row based on data existing in row 'F". Any help that you provide would be greatly appreciated. This is what I now have: Option Explicit Sub CopyRowsWithConFormat() Dim SearchRange As Range Dim EachCell As Range Dim CopyRange As Range Dim nSh As Worksheet Application.ScreenUpdating = False Columns("N:N").Hidden = False Set SearchRange = ActiveSheet.Range("C1:Q5000") 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.Interior.ColorIndex = 8 Or EachCell.Interior.ColorIndex = 33 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 Columns("A:A").ColumnWidth = 5.43 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 = 4.57 Columns("O:O").ColumnWidth = 5.86 Columns("P:P").ColumnWidth = 5.29 Columns("Q:Q").ColumnWidth = 16.86 Columns("N:N").Hidden = True Columns("G:G").Select With Selection .WrapText = True End With NameZM Columns("R:R").Hidden = True UpdateHeader Range("P1").Select Application.ScreenUpdating = True End Sub -- By persisting in your path, though you forfeit the little, you gain the great. |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Simplify code copy based on condition
Hi,
Replace this Set SearchRange = ActiveSheet.Range("C1:Q5000") with this lastrow = Cells(Rows.Count, "F").End(xlUp).Row Set SearchRange = ActiveSheet.Range("C1:Q" & lastrow) because you have declared option explicit you must Dim Lastrow Dim lastrow As Long Mike "DavidH56" wrote: Hello, I would like help modifying my code for copying rows with certain conditions to a new sheet. I currently have code with a range extending to 5000 but the rows may vary from day to day. I like to it to look at the last row based on data existing in row 'F". Any help that you provide would be greatly appreciated. This is what I now have: Option Explicit Sub CopyRowsWithConFormat() Dim SearchRange As Range Dim EachCell As Range Dim CopyRange As Range Dim nSh As Worksheet Application.ScreenUpdating = False Columns("N:N").Hidden = False Set SearchRange = ActiveSheet.Range("C1:Q5000") 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.Interior.ColorIndex = 8 Or EachCell.Interior.ColorIndex = 33 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 Columns("A:A").ColumnWidth = 5.43 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 = 4.57 Columns("O:O").ColumnWidth = 5.86 Columns("P:P").ColumnWidth = 5.29 Columns("Q:Q").ColumnWidth = 16.86 Columns("N:N").Hidden = True Columns("G:G").Select With Selection .WrapText = True End With NameZM Columns("R:R").Hidden = True UpdateHeader Range("P1").Select Application.ScreenUpdating = True End Sub -- By persisting in your path, though you forfeit the little, you gain the great. |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Simplify code copy based on condition
Thanks for you quick response Mike. It works beautifully.
-- By persisting in your path, though you forfeit the little, you gain the great. "Mike H" wrote: Hi, Replace this Set SearchRange = ActiveSheet.Range("C1:Q5000") with this lastrow = Cells(Rows.Count, "F").End(xlUp).Row Set SearchRange = ActiveSheet.Range("C1:Q" & lastrow) because you have declared option explicit you must Dim Lastrow Dim lastrow As Long Mike "DavidH56" wrote: Hello, I would like help modifying my code for copying rows with certain conditions to a new sheet. I currently have code with a range extending to 5000 but the rows may vary from day to day. I like to it to look at the last row based on data existing in row 'F". Any help that you provide would be greatly appreciated. This is what I now have: Option Explicit Sub CopyRowsWithConFormat() Dim SearchRange As Range Dim EachCell As Range Dim CopyRange As Range Dim nSh As Worksheet Application.ScreenUpdating = False Columns("N:N").Hidden = False Set SearchRange = ActiveSheet.Range("C1:Q5000") 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.Interior.ColorIndex = 8 Or EachCell.Interior.ColorIndex = 33 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 Columns("A:A").ColumnWidth = 5.43 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 = 4.57 Columns("O:O").ColumnWidth = 5.86 Columns("P:P").ColumnWidth = 5.29 Columns("Q:Q").ColumnWidth = 16.86 Columns("N:N").Hidden = True Columns("G:G").Select With Selection .WrapText = True End With NameZM Columns("R:R").Hidden = True UpdateHeader Range("P1").Select Application.ScreenUpdating = True End Sub -- By persisting in your path, though you forfeit the little, you gain the great. |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Simplify Code for Copy/Paste Special | Excel Programming | |||
| Copy and Paste based on Condition | Excel Discussion (Misc queries) | |||
| Condition based copy/paste of range | Excel Programming | |||
| Copy range based on condition | Excel Programming | |||
| Copy Row based on a condition | Excel Worksheet Functions | |||
Linear Mode
