Move entire row based on expiration date

[nmccracken12]

I am trying to get this code to work that I found on here. I am able to change the sheet names, but I am not knowledgeable enough to know how to change the cells that matter. Code below. The expiration date sits in column I. The columns in play are A-I. Any one able to help? Thanks in advance!

Sub TransferExpired()
Dim c As Range, TransferRange As Range, DataRange As Range
Dim DestRange As Range
Dim Lr As Long
Dim iCount As Long


With ThisWorkbook
With .Sheets("PROGRAM PERIOD") 'source sheet
Lr = .Cells(.Rows.Count, 1).End(xlUp).Row
Set DataRange = .Range(.Cells(2, 1), .Cells(Lr, 1))
End With


With .Sheets("EXPIRED PROGRAMMING") 'destination sheet
Lr = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Set DestRange = .Cells(Lr, 1)
End With
End With
DataRange.EntireRow.Hidden = False


For Each c In DataRange.Cells
If IsDate(c.Value) Then
If c.Value < Date Then
If TransferRange Is Nothing Then
Set TransferRange = c
Else
Set TransferRange = Union(TransferRange, c)
End If
iCount = iCount + 1
End If
End If
Next c
If Not TransferRange Is Nothing Then
With TransferRange.EntireRow
.Copy DestRange
.Delete
End With
End If

MsgBox iCount & " Expired Records Transferred", 48, "Expired"
End Sub

 

[nmccracken12]

If the TransferExpired code in a STANDARD module?

Dave

I don't really know what that means. I go to developer, click VBA, double click the workbook and paste the code.

 

[dmt32]

I don't really know what that means. I go to developer, click VBA, double click the workbook and paste the code.

Goto the Developer & from menu

Insert > Module

Paste the Code in the inserted module.

Dave

 

[nmccracken12]

Goto the Developer & from menu

Insert > Module

Paste the Code in the inserted module.

Dave

Perfect! Thank you for your patience and help!

 

[dmt32]

Perfect! Thank you for your patience and help!

Most welcome glad all resolved & we appreciate your feedback

Dave

 

[nmccracken12]

Most welcome glad all resolved & we appreciate your feedback

Dave

Good morning Dave,

I have a question. We are now looking at simplifying the sheet with all the programs on it. This would involve another sheet that would be named "Future Programs" and I would want it to take the date from Column H. Once that date become's current, I would want it to move to the "Program Period" sheet and then of course once it expires continues to have it move to the "Expired Progamming" sheet like we currently have it working. I would like both of the moves to have pop ups to tell us how many moved.

I am trying to get better at some of this. I know that I would change the 9 to an 8 here>>> Set DataRange = .Cells(2, 9).Resize(Lr)
What do I change to tell it once this date is current, within range, however it would be worded?

If it easier for you to just put it together, I can look at the differences and figure out what made it work.

 

[rollis13]

I'm not Dave but in the original macro the test on the date is done on this line (now to be updated to new comparison):

If c.Value < Date Then

 

[nmccracken12]

I'm not Dave but in the original macro the test on the date is done on this line (now to be updated to new comparison):

If c.Value < Date Then

Thank you. I did try changing that line and I was able to get it to move a record, but it moved the record that was not current. I had two test records, one that started yesterday and one that starts tomorrow. I did not do something right, but I will keep playing with it.

 

[rollis13]

It would be easier for us if we were able to see your new macro updated with the new column reference and the new comparison.