Moving values based on date.

Mike Neal

New Member
Joined
May 24, 2020
Messages
38
Office Version
  1. 2013
Platform
  1. Windows
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 IDTask IDFrequencyFirst PM DateNext Due Date
R305T432MONTHLY6/12/20207/12/2020
R501T101QUARTERLY6/12/202010/10/2020
R400T105WEEKLY6/12/20206/19/2020
R400T202SEMI-ANNUAL6/12/202012/11/2020
R300T101QUARTERLY6/12/202010/10/2020
R300T105WEEKLY8/7/20208/14/2020

Here is the Task Due Dates sheet. Each time I run the macro it adds the same pairs again.
Equip IDTask ID
R400T105
R305T432
R305T432
R400T105
R305T432
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,508
Office Version
  1. 2019
Platform
  1. Windows
Hi,
untested but see if this update to your could helps you

VBA Code:
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

New Member
Joined
May 24, 2020
Messages
38
Office Version
  1. 2013
Platform
  1. Windows
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

Well-known Member
Joined
Jul 3, 2012
Messages
6,508
Office Version
  1. 2019
Platform
  1. Windows
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

New Member
Joined
May 24, 2020
Messages
38
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

I tried it as is with no changes.
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,508
Office Version
  1. 2019
Platform
  1. Windows
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

New Member
Joined
May 24, 2020
Messages
38
Office Version
  1. 2013
Platform
  1. Windows
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

Well-known Member
Joined
Jul 3, 2012
Messages
6,508
Office Version
  1. 2019
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,129,383
Messages
5,635,951
Members
416,889
Latest member
dhegs

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top