Deleting row after 14 days if...

[bern]

Hi All
Can anybody help with this problem, I have a worksheet that lists all jobs that require a revisit i.e. part required etc after an engineer visit.

Columns A - H contain all the details, and Columns I - J contain a Yes/No dropdown, defaulted to No. Column I would wait for a reference number before job can be done, and Col J is when a job is completed. So eventually both cells will say 'Yes.

As this list is emailed every week and would eventually build up, the jobs that are completed can be deleted so can I put in a macro to delete any row where column's ‘I and ‘J are both ‘Yes after 14 days.

The reason for the 14 days is so that any emailed sheet would contain the completed jobs at least once.

Hope this is clear enough
Bern

[Nigel]

Hi
You need to record the date that the job was completed, you do not indicate
if such a date exists already but I have assumed there is a date in column K
of my example below, which will remove all rows (on sheet1) where I and J
contains Yes and column K is more than 14 days old relative to the system
date.
The code acts on ALL rows from the last row where column I has a value.
(Change references to the sheet and date column if different).

Sub RemoveOldJobs()
Dim LastRow As Long, xR As Long
With Sheets("Sheet1")
LastRow = .Cells(Rows.Count, "I").End(xlUp).Row
For xR = LastRow To 1 Step -1
If .Cells(xR, "I") = "Yes" And .Cells(xR, "J") = "Yes" _
And .Cells(xR, "K") + 14 < Date Then _
Rows(xR).EntireRow.Delete
Next xR
End With
End Sub

--
Cheers
Nigel



"bern" <[email protected]> wrote in message
news:[email protected]...
>
> Hi All
> Can anybody help with this problem, I have a worksheet that lists all
> jobs that require a revisit i.e. part required etc after an engineer
> visit.
>
> Columns A - H contain all the details, and Columns I - J contain a
> Yes/No dropdown, defaulted to No. Column I would wait for a reference
> number before job can be done, and Col J is when a job is completed. So
> eventually both cells will say 'Yes.
>
> As this list is emailed every week and would eventually build up, the
> jobs that are completed can be deleted so can I put in a macro to
> delete any row where column's 'I and 'J are both 'Yes after 14 days.
>
> The reason for the 14 days is so that any emailed sheet would contain
> the completed jobs at least once.
>
> Hope this is clear enough
> Bern
>
>
> --
> bern
> ------------------------------------------------------------------------
> bern's Profile:
http://www.excelforum.com/member.php...o&userid=20169
> View this thread: http://www.excelforum.com/showthread...hreadid=478877
>

[bern]

Hi Nigel
Firstly the code works great and secondly Column K does have the dates in.
Many thanks.

I would like to move the goalposts slightly (British Expression).
I have put your code in a module along with some other code to run macro on all sheets, see below. The reason being is that there are 8 engineers with there own worksheets.

Sub RemoveOldJobs()
Dim LastRow As Long, xR As Long
With Sheets("Sheet1")
LastRow = .Cells(Rows.Count, "I").End(xlUp).Row
For xR = LastRow To 1 Step -1
If .Cells(xR, "I") = "Yes" And .Cells(xR, "J") = "Yes" _
And .Cells(xR, "K") + 14 < Date Then _
Rows(xR).EntireRow.Delete
Next xR
End With
End Sub


Sub DoAllSheets()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Sheets
Criteria
RemoveOldJobs
Next Sht
End Sub

1. I would like to know how to do (RemoveOldJobs) just the relevant worksheets in the workbook, there are about 24 other non relevant worksheets.

2. Instead of deleting the rows as per your code but to cut and paste before deleting row into a new sheet called RTF Completed.
This is for invoicing and archive reasons.

3. How can I set the macro to run periodically?

Many thanks in anticipation
Bernard

[Nigel]

1. I would modify the RemoveOldJobs by adding a parameter that is passed to
it from a calling programme. In the parameter you pass the name of the
worksheet you wish to act on, that way the calling programme can sequence
through a list of each engineers worksheet that is relevant.

Something like
Sub RemoveOldJobs(wksName as String)
Dim LastRow As Long, xR As Long
With Sheets(wksName)
.... rest of sub as provided
.....
End With
End Sub

The calling programme could then do something like

Sub DoAllSheets
Call RemoveOldJobs("Sheet1")
Call RemoveOldJobs("Sheet2")
etc......
End Sub

Be aware that using Sheet names in this way is dangerous if the user changes
the tab name. I personally use the codename for the sheets which you can
see and set in the VBE editor only. Then changes to the sheet name tabs has
no effect.

2. To copy the row to a worksheet called RTF (assume one for the entire
workbook not for each engineer)
Then you must do two things :-
a. Determine the next available row on the RTF sheet to store the
'deleted' row and increment the counter for each row
b. Copy the entire row to the next available row on the RTF sheet before it
is deleted

You might like to consider sorting the RTF sheet after the procedure run to
get them in the right order (I have not included this)

I would build it into the RemoveOldJobs procedure, so the code now looks
like..

Sub RemoveOldJobs(wksName As String)
Dim LastRow As Long, xR As Long, xRTF As Long
xRTF = Sheets("RTF").Cells(Rows.Count, "I").End(xlUp).Row

With Sheets(wksName)
LastRow = .Cells(Rows.Count, "I").End(xlUp).Row
For xR = LastRow To 1 Step -1
If .Cells(xR, "I") = "Yes" And .Cells(xR, "J") = "Yes" _
And .Cells(xR, "K") + 14 < Date Then
xRTF = xRTF + 1
.Rows(xR).EntireRow.Copy Destination:=Sheets("RTF").Cells(xRTF, 1)
.Rows(xR).EntireRow.Delete
End If
Next xR
End With
End Sub

3. Run it periodically, I assume automatically, as of course you can run
when ever you like manually.
Since I assume you would want all completed jobs to appear in the RTF sheet
ASAP (especially if invoicing is involved !) I would place a call to the
DoAllSheets procedure in the workbook open event, then whenever it is opened
the completed jobs will be sweep up automatically.

In the ThisWorkbook code use...

Private Sub Workbook_Open()
Call DoAllJobs
End Sub

You can of course still run it manually.

Hope this helps.

--
Cheers
Nigel



"bern" <[email protected]> wrote in message
news:[email protected]...
>
> Hi Nigel
> Firstly the code works great and secondly Column K does have the dates
> in.
> Many thanks.
>
> I would like to move the goalposts slightly (British Expression).
> I have put your code in a module along with some other code to run
> macro on all sheets, see below. The reason being is that there are 8
> engineers with there own worksheets.
>
> Sub RemoveOldJobs()
> Dim LastRow As Long, xR As Long
> With Sheets("Sheet1")
> LastRow = .Cells(Rows.Count, "I").End(xlUp).Row
> For xR = LastRow To 1 Step -1
> If .Cells(xR, "I") = "Yes" And .Cells(xR, "J") = "Yes" _
> And .Cells(xR, "K") + 14 < Date Then _
> Rows(xR).EntireRow.Delete
> Next xR
> End With
> End Sub
>
>
> Sub DoAllSheets()
> Dim Sht As Worksheet
> For Each Sht In ActiveWorkbook.Sheets
> Criteria
> RemoveOldJobs
> Next Sht
> End Sub
>
> 1. I would like to know how to do (RemoveOldJobs) just the relevant
> worksheets in the workbook, there are about 24 other non relevant
> worksheets.
>
> 2. Instead of deleting the rows as per your code but to cut and paste
> before deleting row into a new sheet called RTF Completed.
> This is for invoicing and archive reasons.
>
> 3. How can I set the macro to run periodically?
>
> Many thanks in anticipation
> Bernard
>
>
> --
> bern
> ------------------------------------------------------------------------
> bern's Profile:
http://www.excelforum.com/member.php...o&userid=20169
> View this thread: http://www.excelforum.com/showthread...hreadid=478877
>

[bern]

Hi Nigel
Works great now
Thank you so much for your help

Bernard