Tricky Macro Question

  • Thread starter Thread starter Philip
  • Start date Start date
P

Philip

I created a worksheet that consists of multiple fields of data (the columns
are ie. date, point of contact, completion date, etc) and based on the inputs
into those columns I have a formula that calculates whether or not a
particular row of data should be classified as "Red" "Green" or "yellow".

I would like to be able to create a macro which in turn takes all rows that
have a "Red" qualifier and input that data onto a new worksheet. Also, I
would like that macro to take all rows that have a "Green" qualifier and
input that data onto another new worksheet.

I would appreciate any guidance that you may have in helping me complete
this task.

Thank you!
 
you can try to record macro to filter it on the colume of red/green/yellow
then copy and paste the data into the tab you want.

the range of selection is a little tricky as the no. of row is changing. but
you can use these code to locate it, assume a2 is where you start with

... filtering code here...

range("a2").select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select

then go to the red tab then passte it.

repeat code for 3 colour.
 
Are those real colors, or Conditional Format colors? If real colors, try this:
Sub CopyIfRed()
Dim i As Long
k = 1
Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.Count + r.Row - 1
For i = 1 To nLastRow
If is_it_red(i) Then
Set rc = Cells(i, 1).EntireRow
Set rd = Sheets("Sheet2").Cells(k, 1)
rc.Copy rd
k = k + 1
End If
Next
End Sub

Function is_it_red(i As Long) As Boolean
is_it_red = False
For j = 1 To Columns.Count
If Cells(i, j).Interior.ColorIndex = 3 Then
is_it_red = True
Exit Function
End If
Next
End Function
 
It is always helpful to give specifics about your layout for those items you
are referencing (otherwise we have to guess). I am assuming that your color
qualifiers are the words Red, Green and Yellow (and not actual cell colors)
and that they are located in Column A. I am also assuming your data starts
in Row 2 after the assumed header text in Row 1. Here is the macro...

Sub SplitColorRowsToNewSheets()
Dim X As Long, LastRow As Long
Dim SheetNames As Variant, CurrentSheet As Worksheet
Set CurrentSheet = Worksheets("Sheet1")
SheetNames = Array("Red", "Green", "Yellow")
For X = LBound(SheetNames) To UBound(SheetNames)
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = SheetNames(X) & " (" & Date$ & ")"
Next
LastRow = CurrentSheet.Cells(Rows.Count, "A").End(xlUp).Row
For X = 2 To LastRow
With Sheets(CurrentSheet.Cells(X, "A") & " (" & Date$ & ")")
CurrentSheet.Rows(X).Copy .Cells(.Cells(Rows.Count, _
"A").End(xlUp).Row + 1, "A").EntireRow
End With
Next
End Sub
 
Yes Rick you are correct. The colors auto populate in column A based on data
in the columns B-F.

Thank you for your help. I will try this macro.
 
Back
Top