Text output based on date criteria

L

Lrees

New Member
Joined
Feb 7, 2018
Messages
12
Hi everyone,
After many years of diving in and out of the Mr Excel forum for answers to many small questions; it's time to get in and start building up my understanding of macros piece by piece with a figuring some different scenarios these can apply to. Great place, although I've mainly used as reference for formulas and the odd macro for hiding rows and columns to customize various views.

I'm looking to put together a macro that will fill a cell along rows of a table based on certain criteria. I've used this to track actions from meetings however cell E3 had a lengthy formula and didn't cover everything I want to get achieve (along with being difficult to easily alter).

This is intended to run through the length of a table. Apologies if the below gets a little confusing. Dates are DD/MM/YY.

Cell A1 has date of previous meeting ie 01/05/18

Cell A3 has activity description
Cell B3 has date raised ie "04/05/2018"
Cell C3 has date due or note ie "10/05/18" or "Note"
Cell D3 has date complete ie "09/05/18"
Cell E3 has status (this is the cell I want to auto-fill)

1. If Cell B1 is not blank, but cell C3 is blank, cell E3 returns "No Due Date"
2. If Cell D3 is not blank (ie has a completed date) then cell E3 changes to "Complete", or "Closed" if cell D3 is prior to cell A1 - 7 days
3. If Cell C3 says "Note" then, E3 returns "Note" or "Old Note" if B3 is prior to cell A1
4. If Cell C3 date equals todays date then cell E3 returns "Due Today"
5. If Cell C3 date is within 7 days of todays date cell E3 Returns "Due Within 7 Days"
6. If Cell C3 dats is between 7-14 days of todays date cell E3 returns "Due Within 14 Days"
7. If Cell C3 date is greater than 14 days from todays date cell E3 returns "Open"
8. If Cell C3 date less than todays date then cell E3 returns "Overdue"

This would need to run to the end of the table - note sure how you would define that.
End goal would be to color each row in column C of the table based on the outcome ie "overdue" red, "due today" orange etc.

[TABLE="width: 593"]
<tbody>[TR]
[TD]Previous Meeting:[/TD]
[TD]1/05/2018[/TD]
[TD][/TD]
[TD="colspan: 2"](Assume todays date is 18/05/18)[/TD]
[/TR]
[TR]
[TD]Item[/TD]
[TD]Raised[/TD]
[TD]Due[/TD]
[TD]Complete[/TD]
[TD]Status[/TD]
[/TR]
[TR]
[TD]Task 1[/TD]
[TD]4/05/2018[/TD]
[TD][/TD]
[TD][/TD]
[TD]No Due Date[/TD]
[/TR]
[TR]
[TD]Task 2.1[/TD]
[TD]4/05/2018[/TD]
[TD]7/05/2018[/TD]
[TD]8/05/2018[/TD]
[TD]Complete[/TD]
[/TR]
[TR]
[TD]Task 2.2[/TD]
[TD]1/04/2018[/TD]
[TD]8/04/2018[/TD]
[TD]9/04/2018[/TD]
[TD]Closed[/TD]
[/TR]
[TR]
[TD]Task 3[/TD]
[TD]4/05/2018[/TD]
[TD]Note[/TD]
[TD][/TD]
[TD]Note[/TD]
[/TR]
[TR]
[TD]Task 4[/TD]
[TD]4/05/2018[/TD]
[TD]18/05/2018[/TD]
[TD][/TD]
[TD]Due Today[/TD]
[/TR]
[TR]
[TD]Task 5[/TD]
[TD]4/05/2018[/TD]
[TD]20/05/2018[/TD]
[TD][/TD]
[TD]Due Within 7 Days[/TD]
[/TR]
[TR]
[TD]Task 6[/TD]
[TD]4/05/2018[/TD]
[TD]28/05/2018[/TD]
[TD][/TD]
[TD]Due Within 14 Days[/TD]
[/TR]
[TR]
[TD]Task 7[/TD]
[TD]4/05/2018[/TD]
[TD]2/06/2018[/TD]
[TD][/TD]
[TD]Open[/TD]
[/TR]
[TR]
[TD]Task 8[/TD]
[TD]4/05/2018[/TD]
[TD][/TD]
[TD]15/05/2018[/TD]
[TD]Overdue[/TD]
[/TR]
</tbody><colgroup><col><col span="3"><col></colgroup>[/TABLE]
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
Lrees,

First let me say THANK YOU for very descriptive post! I think I can build you a solution and it is so helpful to have sample data and definitive requirements. So often that is not the case!

I'll get back to you with a solution.
 
Upvote 0
frank_AL said:
Lrees,

First let me say THANK YOU for very descriptive post! I think I can build you a solution and it is so helpful to have sample data and definitive requirements. So often that is not the case!

I'll get back to you with a solution.
Click to expand...

Thanks Frank_AL, thought it's best to give some background info on it's end use to other can maybe use or adapt to suit another method.
 
Upvote 0
Okay, I think I have a solution for you. Give it a try and let me know if you encounter any problems.

Code: 
Option Explicit


Sub CalculateStatus()
Dim lr As Long
Dim i As Long


lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = 3 To lr
    If Cells(i, "C") = "" Then
        Cells(i, "E").Value = "No Due Date"
    ElseIf Cells(i, "D").Value <> "" Then
        If Cells(i, "D").Value - Cells(1, "A").Value >= 7 Then
            Cells(i, "E").Value = "Complete"
        Else
            Cells(i, "E").Value = "Closed"
        End If
    ElseIf Cells(i, "C").Value <> "" Then
        If Cells(i, "C").Value = "Note" Then
            If Cells(i, "B").Value < Cells(1, "A").Value Then
                Cells(i, "E").Value = "Old Note"
            Else
                Cells(i, "E").Value = "Note"
            End If
'        If Cells(i, "C").Value = Date Then
        ElseIf Cells(i, "C").Value - Cells(1, "A") >= 0 Then
            If Cells(i, "C").Value = Cells(1, "C").Value Then
                Cells(i, "E").Value = "Due Today"
            ElseIf Cells(i, "C").Value - Cells(1, "A") <= 7 Then
                Cells(i, "E").Value = "Due Within 7 Days"
            ElseIf Cells(i, "C").Value - Cells(1, "A") <= 14 Then
                Cells(i, "E").Value = "Due Within 14 Days"
            ElseIf Cells(i, "C").Value - Cells(1, "A") > 14 Then
                Cells(i, "E").Value = "Open"
            End If
        ElseIf Cells(i, "C").Value - Cells(1, "A") < 0 Then
                Cells(i, "E").Value = "Overdue"
        End If
    End If
Next i
    
        
    
    


End Sub
 
Upvote 0
Modified code to address date value equal toToday

Code: 
Option Explicit


Sub CalculateStatus()
Dim lr As Long
Dim i As Long


lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = 3 To lr
    If Cells(i, "C") = "" Then
        Cells(i, "E").Value = "No Due Date"
    ElseIf Cells(i, "D").Value <> "" Then
        If Cells(i, "D").Value - Cells(1, "A").Value >= 7 Then
            Cells(i, "E").Value = "Complete"
        Else
            Cells(i, "E").Value = "Closed"
        End If
    ElseIf Cells(i, "C").Value <> "" Then
        If Cells(i, "C").Value = "Note" Then
            If Cells(i, "B").Value < Cells(1, "A").Value Then
                Cells(i, "E").Value = "Old Note"
            Else
                Cells(i, "E").Value = "Note"
            End If
        ElseIf Cells(i, "C").Value - Cells(1, "A") >= 0 Then
            If Cells(i, "C").Value = Date Then
                Cells(i, "E").Value = "Due Today"
            ElseIf Cells(i, "C").Value - Cells(1, "A") <= 7 Then
                Cells(i, "E").Value = "Due Within 7 Days"
            ElseIf Cells(i, "C").Value - Cells(1, "A") <= 14 Then
                Cells(i, "E").Value = "Due Within 14 Days"
            ElseIf Cells(i, "C").Value - Cells(1, "A") > 14 Then
                Cells(i, "E").Value = "Open"
            End If
        ElseIf Cells(i, "C").Value - Cells(1, "A") < 0 Then
                Cells(i, "E").Value = "Overdue"
        End If
    End If
Next i
 
Upvote 0
Thanks Frank_AL, worked a treat!

frank_AL said:
Modified code to address date value equal toToday

Code: 
Option Explicit


Sub CalculateStatus()
Dim lr As Long
Dim i As Long


lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = 3 To lr
    If Cells(i, "C") = "" Then
        Cells(i, "E").Value = "No Due Date"
    ElseIf Cells(i, "D").Value <> "" Then
        If Cells(i, "D").Value - Cells(1, "A").Value >= 7 Then
            Cells(i, "E").Value = "Complete"
        Else
            Cells(i, "E").Value = "Closed"
        End If
    ElseIf Cells(i, "C").Value <> "" Then
        If Cells(i, "C").Value = "Note" Then
            If Cells(i, "B").Value < Cells(1, "A").Value Then
                Cells(i, "E").Value = "Old Note"
            Else
                Cells(i, "E").Value = "Note"
            End If
        ElseIf Cells(i, "C").Value - Cells(1, "A") >= 0 Then
            If Cells(i, "C").Value = Date Then
                Cells(i, "E").Value = "Due Today"
            ElseIf Cells(i, "C").Value - Cells(1, "A") <= 7 Then
                Cells(i, "E").Value = "Due Within 7 Days"
            ElseIf Cells(i, "C").Value - Cells(1, "A") <= 14 Then
                Cells(i, "E").Value = "Due Within 14 Days"
            ElseIf Cells(i, "C").Value - Cells(1, "A") > 14 Then
                Cells(i, "E").Value = "Open"
            End If
        ElseIf Cells(i, "C").Value - Cells(1, "A") < 0 Then
                Cells(i, "E").Value = "Overdue"
        End If
    End If
Next i
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

SaraWitch
  • Solved
Overdue date
Replies
4
Views
880
etaf
etaf
S
  • Question Question
Using IFS to calculate a task due by date but needing to remove weekends
Replies
3
Views
474
awoohaw
awoohaw
R
  • Solved
Adding Hours & Minutes to Dates & Times w/in Working Hours
2
Replies
11
Views
668
Asbestos_Jen
Asbestos_Jen
SaraWitch
  • Solved
Calculate days between three dates
Replies
6
Views
351
Joe4
Joe4
A
  • Solved
Extract last amounts in column within two dates
Replies
7
Views
108
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,224,749
Messages
6,180,727
Members
452,995
Latest member
isldboy

Share this page

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
Back
Top