Copy row to a worksheet based on date.

**Lasant** · 07-17-2009, 11:53 AM

Hello all,

This is my first time posting on Excel Forum. I've seen what you all can do and I'm sure my request will be a piece of cake.

Basically, what I'm shooting for is a spreadsheet that helps me keep track of contracts that are up for renewal. The way I would like this to happen is by having every row that has an "END DATE" that is within 60 days of TODAY'S date, copied to a second worksheet called "RENEWALS." Also, it would be great if there was a button that I could hit to run the code. That's pretty much it.

I've included a dummy spreadsheet that exactly matches the format of the spreadsheet I intend to use for the real thing.

Thanks in advance!
~Francisco

P.S.
If anyone feels like taking this a little further, it would be really useful if the row could also get a "color fill" based on the date. For example, if the row's end date is coming up in 60 days or less, the row would turn yellow. If the row's end date has already expired, the row would turn red.

**NBVC** · 07-17-2009, 12:35 PM

See attached.

Add a column in the All sheet (Column N) and in N5 entered formula:

=IF(A5="","",IF(K5<=TODAY()+60,MAX($N$4:N4)+1,""))

which counts the number of matches (within 60 days of today)..

formula is copied down to row 100 to accomodate future additions.. you can copy down even further.

then in Renewals sheet...in A2, use formula:

=IF(ROWS($A$2:$A2)>MAX(All!N:N),"",ROWS($A$2:$A2)) copied down to count count of rows that will be extracted... copy down as far as you want..

in B2, use formula and copy down as far as you want and across all columns...

=IF($A2="","",INDEX(All!A:A,MATCH($A2,All!$N:$N,0)))

no need for button.. live update.

**Paul** · 07-17-2009, 12:36 PM

Hi Lasant, welcome to the forum.

1. Add a command button to your "All" worksheet from the Controls Toolbox toolbar (not the Forms toolbar).
2. Double-click the button to open the VB Editor
3. Copy the code shown below and insert it between the new section of code that will appear ("Private Sub CommandButton1_Click() ..... End Sub").

Dim i As Long, nRow As Long
nRow = Sheets("Renewals").Range("A65536").End(xlUp).Row

For i = 5 To Range("K65536").End(xlUp).Row
    If Cells(i, "K").Value < Date + 60 Then
        Cells(i, "K").EntireRow.Copy Sheets("Renewals").Range("A" & nRow + 1)
        nRow = nRow + 1
    End If
Next i

You can then close the VB Editor window. Also, you can right-click on the command button and choose Properties to set it's Caption (e.g. "Update Renewal Sheet") and it's font color, background color, etc. Once you're done formatting the button, click the Design Mode button to take your worksheet out of Design Mode (looks like a small triangle with a ruler and pencil).

All that's left to do then is click the button and let the macro do its job. Try this on a backup workbook first, of course!

**Lasant** · 07-20-2009, 05:15 PM

Hey guys,

Thank you so much for your responses. Both suggestions worked as described. Although Paul's code is closer to what I asked for and cleaner to implement, I actually like NBVC's solution better. Here's why:

Paul's solution creates a button which copies and pastes the intended lines to the Renewal worksheet, which is nice, but if it's accidentally clicked again, it creates doubles (or triples, etc.) for every line item. When dealing with the full-sized spreadsheet, this becomes a risk that I am unwilling to take.

NBVC's solution is always active. If there are any line items that trigger the code, they are found in the renewal worksheet. Once the end dates are updated, the line items disappear from the renewal worksheet. The automation is convenient and lessens the chance of user error. The only downside is that once the data reaches the renewal worksheet, it is no longer sortable.

Thanks again!
~Francisco

**NBVC** · 07-20-2009, 05:25 PM

Happy you found a satisfactory solution..

Please remember to mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save