PDA

View Full Version : [SOLVED] Run this with a condition



ndendrinos
10-20-2008, 08:11 AM
Sub CopyData()
'by Tom Ogilvy
Application.ScreenUpdating = False
Sheets("Template").Visible = True
Dim cell As Range, rng As Range
Dim sh As Worksheet
With Worksheets("Sheet1")
Set rng = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
End With
For Each cell In rng
Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
' assume the name for the row/sheet is in column 1 (col A)
ActiveSheet.Name = cell.Value
Set sh = ActiveSheet
cell.EntireRow.Copy sh.Rows(1)
Range("A1:J1").Select
Selection.Font.ColorIndex = 2
Range("E3").Select
Next
Sheets("Template").Visible = False
Application.ScreenUpdating = True
End Sub

Need to introduce a condition to this code so that it works just on the rows that are in red font.
Thank you

Also is there a better way to write the code in the "Private Sub Worksheet_SelectionChange" in sheet1

Bob Phillips
10-20-2008, 08:15 AM
Sub CopyData()
'by Tom Ogilvy
Application.ScreenUpdating = False
Sheets("Template").Visible = True
Dim cell As Range, rng As Range
Dim sh As Worksheet
With Worksheets("Sheet1")
Set rng = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
End With
For Each cell In rng
If cell.Font.ColorIndex = 3 Then
Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
' assume the name for the row/sheet is in column 1 (col A)
ActiveSheet.Name = cell.Value
Set sh = ActiveSheet
cell.EntireRow.Copy sh.Rows(1)
Range("A1:J1").Font.ColorIndex = 2
Range("E3").Select
End If
Next
Sheets("Template").Visible = False
Application.ScreenUpdating = True
End Sub

Bob Phillips
10-20-2008, 08:17 AM
Event code



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
With Target.EntireRow.Font
.Bold = True
.ColorIndex = 3
End With
End If
End Sub

ndendrinos
10-20-2008, 08:22 AM
Thank you very much for both codes XLD