I have the following code and it works perfectly for the task i want it to do... That is to search a column for "Closed" or "Cancelled" and move all those rows containing "Closed" or "Cancelled" to sheet2 and remove them from sheet1.

Sub ClosedRoutine()

Dim iCt As Integer
Dim iRow1 As Integer
Dim iRow2 As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim erow As Integer

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
iRow1 = 6
erow = 5
While ws2.Cells(erow, 28) < "": erow = erow + 1: Wend
iRow2 = erow

'copy from sheet1 to sheet2
Do Until ws1.Cells(iRow1, 28) = "END"
If ws1.Cells(iRow1, 28) = "Closed" Or ws1.Cells(iRow1, 28) = "Cancelled" Then
For iCt = 1 To 29
ws2.Cells(iRow2, iCt) = ws1.Cells(iRow1, iCt)
Next iCt
iRow2 = iRow2 + 1
End If
iRow1 = iRow1 + 1
Loop

'delete from sheet1
For iCt = iRow1 To 2 Step -1
If ws1.Cells(iCt, 28) = "Closed" Or ws1.Cells(iCt, 28) = "Cancelled" Then ws1.Rows(iCt).Delete
Next iCt

End Sub

---------------------------

Now comes part two which is what I need help with. I want it so that all the "Closed" or "Cancelled" items in sheet2 that are 90 days over the actual closing date (there is a column that has the actual closing dates in 10/07/2003 or 10-July-03 format) get sent to sheet3. I figure that I can just use the same code as above.. but I need to alter it a little.

Sub ArchiveRoutine()

Dim iCt2 As Integer
Dim iRow3 As Integer
Dim iRow4 As Integer
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim erow2 As Integer

Set ws3 = Sheets("Sheet2")
Set ws4 = Sheets("Sheet3")
iRow3 = 6
erow2 = 5
While ws4.Cells(erow, 28) < "": erow2 = erow2 + 1: Wend
iRow4 = erow2

'copy from sheet2 to sheet3
Do Until ws3.Cells(iRow3, 28) = ""

[Note: Below is a part I need to change completely I think. What I Need to do is this: If the difference between todays date and the actual close out date (column 12) is greater than or equal to 90€¦ then copy that row to sheet3]

If ws3.Cells(iRow3, 28) = "Closed" Or ws3.Cells(iRow3, 28) = "Cancelled" Then

For iCt2 = 1 To 29
ws4.Cells(iRow4, iCt2) = ws3.Cells(iRow3, iCt2)
Next iCt2
iRow4 = iRow4 + 1
End If
iRow3 = iRow3 + 1
Loop

[Note: Below is another part I need to change completely I think. What I need to do is this: Remove the rows that were copied to sheet3 (ie. remove the duplicates)]

'delete from sheet2
For iCt2 = iRow3 To 2 Step -1
If ws3.Cells(iCt2, 28) = "Closed" Or ws3.Cells(iCt2, 28) = "Cancelled" Then ws3.Rows(iCt2).Delete
Next iCt2

End Sub

Any ideas on how I would go about doing this? Im a bit lost again€¦ ahhh. Any help would be greatly appreciated! Thanks

-Jay Baxter