Moving values based on date.

[Mike Neal]

I am trying to move values from on sheet to another if the "Due Date" is within 7 days or less of today's date. The macro I am using works but duplicates entries. I plan to keep this sheet as a record of tasks performed on equipment. In the PM Schedule sheet I am using column A for Equipment IDs and column B for Task IDs. The Equipment ID may have more than one Task ID assigned to it or the Task ID may be assigned to more than one Equipment ID. If the macro would checked to see if the combination of Equip ID and Task ID already exists and only add "New" pairs to the next empty row it would be great. Thanks for the help.

This is the macro I am using:
Private Sub MOVE_DUE_TASKS()

'Declare variables.
Dim lr As Long, lr2 As Long, r As Long
Dim dataSheet As Worksheet
Set dataSheet = Worksheets("PM Schedule")
With dataSheet
lr = Sheets("PM Schedule").Cells(Rows.Count, "E").End(xlUp).row 'Where date is that is being compared.
lr2 = Sheets("Task Due Dates").Cells(Rows.Count, "C").End(xlUp).row 'Where data is going.
For r = lr To 2 Step -1 'Step thru each row.
If IsDate(Sheets("PM Schedule").Range("E" & r).value) Then 'If data is a date.
If (Sheets("PM Schedule").Range("E" & r).value) <= (Date + 7) Then 'If date is 7 days or less from today.
Sheets("PM Schedule").Range("A" & r & ":B" & r).Copy destination:=Sheets("Task Due Dates").Range("A" & lr2 + 1) 'Copy data from each row.
lr2 = Sheets("Task Due Dates").Cells(Rows.Count, "A").End(xlUp).row 'Paste data one row at a time.
End If
End If
Next r
End With
End Sub

This is the Task Due Dates Sheet

Equip ID	Task ID	Frequency	First PM Date	Next Due Date
R305	T432	MONTHLY	6/12/2020	7/12/2020
R501	T101	QUARTERLY	6/12/2020	10/10/2020
R400	T105	WEEKLY	6/12/2020	6/19/2020
R400	T202	SEMI-ANNUAL	6/12/2020	12/11/2020
R300	T101	QUARTERLY	6/12/2020	10/10/2020
R300	T105	WEEKLY	8/7/2020	8/14/2020

Here is the Task Due Dates sheet. Each time I run the macro it adds the same pairs again.

Equip ID	Task ID
R400	T105
R305	T432
R305	T432
R400	T105
R305	T432

 

[dmt32]

Hi,
untested but see if this update to your could helps you

Sub MOVE_DUE_TASKS()
    
'Declare variables.
    Dim lr As Long, lr2 As Long, r As Long
    Dim wsPMSchedule As Worksheet, wsTaskDueDates As Worksheet
    Dim rng As Range, cell As Range
    
    Set wsPMSchedule = Worksheets("PM Schedule")
    Set wsTaskDueDates = Worksheets("Task Due Dates")
    
'Where data is going.
    lr2 = wsTaskDueDates.Cells(wsTaskDueDates.Rows.Count, "A").End(xlUp).Row + 1
    
    With wsPMSchedule
'Where date is that is being compared.
        lr = .Cells(.Rows.Count, "E").End(xlUp).Row
        
'Step thru each row.
        For r = lr To 2 Step -1
        Set cell = .Range("A" & r)
'If data is a date.
            If IsDate(cell.Offset(, 4).Value) Then
'If date is 7 days or less from today & not already moved to Task Due Dates.
                If cell.Offset(, 4).Value <= (Date + 7) And cell.Offset(, 5) <> "Moved" Then
'mark the range
                    If rng Is Nothing Then Set rng = cell.Resize(, 2) Else Set rng = Union(rng, cell.Resize(, 2))
'update to Moved
                    cell.Offset(, 5).Value = "Moved"
                End If
            End If
            Set cell = Nothing
        Next r
    End With
'copy records
    If Not rng Is Nothing Then rng.Copy wsTaskDueDates.Range("A" & lr2)

End Sub

Dave

 

[Mike Neal]

The macro adds the value "Moved" but does not copy the data to Task Due Dates sheet. Not sure what to change in the copy records line. Thank you.

 

[dmt32]

The macro adds the value "Moved" but does not copy the data to Task Due Dates sheet. Not sure what to change in the copy records line. Thank you.

"Moved" is a tag to prevent duplicates being copied - Just run code from data supplied & worked ok for me
Did you try code as published? or have you made some changes?

Dave

 

[Mike Neal]

I tried it as is with no changes.

 

[dmt32]

I tried it as is with no changes.

with sample data provided, all ok for me - Are you able to place copy of your workbook with sample data in a dropbox & provide link to it here?

Dave

 

[Mike Neal]

Not sure what I did the first time but when I deleted the "moved" from PM Schedule and reran the code it worked fine. Thanks again.

 

[dmt32]

Not sure what I did the first time but when I deleted the "moved" from PM Schedule and reran the code it worked fine. Thanks again.

Clearly the idea is doing what you required.

Glad resolved

Dave