Duration countdown (single input)

mharchitect

New Member
Joined
Mar 18, 2019
Messages
11
Test this to see if it does what you want

With worksheet laid out like this

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]
A
[/th][th]
B
[/th][th]
C
[/th][th]
D
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
1
[/td][td]Task[/td][td]Planned[/td][td]Remaining[/td][td]Start Date[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
2
[/td][td]t1[/td][td]
11​
[/td][td]
2​
[/td][td]
15/03/2019​
[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
3
[/td][td]t2[/td][td]
15​
[/td][td]
11​
[/td][td]
20/03/2019​
[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
4
[/td][td]t3[/td][td]
10​
[/td][td]
10​
[/td][td]
24/03/2019​
[/td][/tr]
[/table]
[Table="width:, class:grid"][tr][td]Sheet: NameOfSheet[/td][/tr][/table]



CODE

In THISWORKBOOK module
Code:
Private Sub Workbook_Open()
    Call UpdateValues
End Sub

In SHEET module
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Start As Range
    If Target.Row = 1 Or Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Set Start = Target.Offset(, 2)
        Start.NumberFormat = "dd/mm/yyyy"
        If Start = "" Then Start = Date
        Target.Offset(, 1) = CLng(Target + Start - Date)
    End If
End Sub

In STANDARD module
Code:
Sub UpdateValues()
    Dim Ws As Worksheet, Cel As Range, Rng As Range, EndDate As Long
    Set Ws = Sheets("NameOfSheet")
    Set Rng = Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
    For Each Cel In Rng
        EndDate = Cel.Offset(, 3) + Cel.Offset(, 1)
        With Cel.Offset(, 2)
            If EndDate >= Date Then .Value = CLng(EndDate - Date) Else .Value = "overdue"
        End With
    Next Cel
End Sub
 
Upvote 0

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
This is much better, thank you. But both columns C & D are static. When I change the machine date, the new task takes the new date as Sart date and the old ones are not changed, till now this is perfect.
But remaining dates of the old tasks are not updated when I change the machine date. Can we make Column D static and Column C dynamic so that it will be linked to Today () function to calculate the new remaining days when the date changes?
 
Upvote 0
I do not understand why you have a problem :confused:
- running UpdateValues should do everything you need
- explanations below should help you get there

But both columns C & D are static
column C is not static
- it ALWAYS changes if column B changes
- you can run UpdateValues whenever you want to recalculate column C

When I change the machine date, the new task takes the new date as Sart date and the old ones are not changed
Why are you changing the machine date? :confused:
- I never manually change the PC date

Can we make Column D static and Column C dynamic so that it will be linked to Today () function to calculate the new remaining days when the date changes?

In post#5, I gave you code below so that column C is recalculated when the workbook is opened
- if the date has changed, column C is automatically recalculated
(must be in ThisWorkbook module)
Code:
Private Sub Workbook_Open()
    Call UpdateValues
End Sub

After changing the machine date you could
- save the file, close it and reopen it (above code recalculates column C)
OR
- add a button so that you can run UpdateValues (recalculates column C)
OR
- force a recalclulation of column C every thime the workbook is saved by ...
... placing code below in ThisWorkbook module (NOT standard or sheet module)
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Call UpdateValues
End Sub

If I have misunderstood something, please explain EXACTLY what you are trying to do, listing ALL the steps
 
Last edited:
Upvote 0
I found that macros were not enabled. Now it's working well.
Another thing... Can we add a status column. So after completion, a task can have a "done" status? And the Remaining will turn to 0.
Otherwise, all tasks will become overdue.
Thanks
 
Upvote 0
Hello again my friend, are you on a leave these days?

I appreciate if you come back with a hint on the last query above.

Many thanks again for your support.
 
Upvote 0
Can we add a status column. So after completion, a task can have a "done" status? And the Remaining will turn to 0
Code below works for me

- status column is now column E
- original code simplified where possible and feature requested has been added
- click on cell in E and value toggles between "Done" and blank and the value in column C is updated accordingly

in SHEET module
Code:
toggles value in column E
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Target
        If .Row = 1 Or .CountLarge > 1 Then Exit Sub
        If .Column = 5 Then
            If .Value = "" Then .Value = "Done" Else .Value = ""
            .Offset(, 1).Select
            Call UpdateValues
        End If
    End With
End Sub
'reacts to changes in column B, puts current date in column D, runs UpdateValues
Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Row = 1 Or .Count > 1 Then Exit Sub
        If .Column = 2 Then
            If .Offset(, 2) = "" Then .Offset(, 2) = Date
            Call UpdateValues
        End If
    End With
End Sub
in STANDARD module
Code:
Sub UpdateValues()
    Dim Cel As Range, EndDate As Long, ws As Worksheet
    Set ws = Sheets("[I][COLOR=#ff0000]NameOfSheet[/COLOR][/I]")
    For Each Cel In ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp))
        EndDate = Cel.Offset(, 3) + Cel.Offset(, 1)
        Cel.Offset(, 3).NumberFormat = "dd/mm/yyyy"
        With Cel.Offset(, 2)
            If EndDate >= Date Then .Value = CLng(EndDate - Date) Else .Value = "overdue"
            If Cel.Offset(, 4) = "Done" Then .Value = 0
        End With
    Next Cel
End Sub

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]
A
[/th][th]
B
[/th][th]
C
[/th][th]
D
[/th][th]
E
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
1
[/td][td]Task[/td][td]Days[/td][td]Remaining[/td][td]Date[/td][td]Status[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
2
[/td][td]t001[/td][td]
10​
[/td][td]
2​
[/td][td]
28/03/2019​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
3
[/td][td]t002[/td][td]
15​
[/td][td]
8​
[/td][td]
29/03/2019​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
4
[/td][td]t003[/td][td]
16​
[/td][td]
10​
[/td][td]
30/03/2019​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
5
[/td][td]t004[/td][td]
12​
[/td][td]
7​
[/td][td]
31/03/2019​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
6
[/td][td]t005[/td][td]
15​
[/td][td]
11​
[/td][td]
01/04/2019​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
7
[/td][td]BEFORE[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
8
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table]
[Table="width:, class:grid"][tr][td]Sheet: NameOfSheet[/td][/tr][/table]

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]
A
[/th][th]
B
[/th][th]
C
[/th][th]
D
[/th][th]
E
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
1
[/td][td]Task[/td][td]Days[/td][td]Remaining[/td][td]Date[/td][td]Status[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
2
[/td][td]t001[/td][td]
10​
[/td][td]
2​
[/td][td]
28/03/2019​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
3
[/td][td]t002[/td][td]
15​
[/td][td]
8​
[/td][td]
29/03/2019​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
4
[/td][td]t003[/td][td]
16​
[/td][td]
10​
[/td][td]
30/03/2019​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
5
[/td][td]t004[/td][td]
12​
[/td][td]
7​
[/td][td]
31/03/2019​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
6
[/td][td]t005[/td][td]
15​
[/td][td]
0​
[/td][td]
01/04/2019​
[/td][td]Done[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
7
[/td][td]AFTER[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table]
[Table="width:, class:grid"][tr][td]Sheet: NameOfSheet[/td][/tr][/table]
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

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