VBA script doesn't update todays date

[Fredrik1987]

I posted a similiar question earlier, but it was difficult to understand what my exact questions were.
So here goes another try:

This is my worksheet:

Sub Worksheet_Change(ByVal Target As Range)

' Activate the date when I set case as "Active"
If Not Application.Intersect(Target, Range("A1:A1000")) Is Nothing Then
    Application.EnableEvents = False
   
    If Target.Value = "Active" Then _
        ' Date activated
        Target.Offset(, 1).Value = Date
        ' If the work must be done within 12 weeks, set the deadline date into column C (usually we have 12 weeks)
        Target.Offset(, 2).Value = DateAdd("d", 12 * 7, Date)
        ' Show the number of days in column D
        Target.Offset(, 3).Value = DateDiff("d", Date, Target.Offset(, 2)) & " Dager igjen"
    End If

End If

End Sub

Sub Workbook_change(ByVal Target As Range)

' Copied from the script above"
If Not Application.Intersect(Target, Range("A15:A1000")) Is Nothing Then
    Application.EnableEvents = False
   
    If Target.Value = "Active" Then _
        ' This is the part I'm having trouble with, the number of days remaining doesn't change as the deadline approaches
        ' Show the number of days remaining in column D
        Target.Offset(, 3).Value = DateDiff("d", Date, Target.Offset(, 2)) & " Dager igjen"
        
    End If

End If

End Sub

The problem is that column D, Days remaining doesn't update regularly.
I want it to count down the remaining number of days automatically.

 

[Fishboy]

I posted a similiar question earlier, but it was difficult to understand what my exact questions were.
So here goes another try:

This is my worksheet:

Sub Worksheet_Change(ByVal Target As Range)

' Activate the date when I set case as "Active"
If Not Application.Intersect(Target, Range("A1:A1000")) Is Nothing Then
    Application.EnableEvents = False
   
    If Target.Value = "Active" Then _
        ' Date activated
        Target.Offset(, 1).Value = Date
        ' If the work must be done within 12 weeks, set the deadline date into column C (usually we have 12 weeks)
        Target.Offset(, 2).Value = DateAdd("d", 12 * 7, Date)
        ' Show the number of days in column D
        Target.Offset(, 3).Value = DateDiff("d", Date, Target.Offset(, 2)) & " Dager igjen"
    End If

End If

End Sub

Sub Workbook_change(ByVal Target As Range)

' Copied from the script above"
If Not Application.Intersect(Target, Range("A15:A1000")) Is Nothing Then
    Application.EnableEvents = False
   
    If Target.Value = "Active" Then _
        ' This is the part I'm having trouble with, the number of days remaining doesn't change as the deadline approaches
        ' Show the number of days remaining in column D
        Target.Offset(, 3).Value = DateDiff("d", Date, Target.Offset(, 2)) & " Dager igjen"
        
    End If

End If

End Sub

The problem is that column D, Days remaining doesn't update regularly.
I want it to count down the remaining number of days automatically.

This might not be the overall root of your problem, but it certainly wont be helping.

You have a line at the start where Application.EnableEvents = False but nowhere later in the code do you re-enable them with Application.EnableEvents = True. This means that the code will just stop working until they are enabled once again.

 

[Fredrik1987]

Thank you for replying so quickly, that is simply a copy/paste error on my behalf. Even if i set Application.EnableEvents = True after the script, the problem persists. There's also a couple of other spelling errors I've missed:

The last sub should be Workbook_open(ByVal Target as Range) and not Workbook_change, and the range should be "A2:A1000" in both subs.

This is just a small part of a script, and the only line that doesn't work is the column that governs the days remaining until deadline.

 

[stemar]

If you want a countdown, I'd simply put a formula in the Days Remaining column. Something like this:

=if(C3="", "",C3-today() & " Dager igjen"

 

[steve the fish]

You are putting a string into column D. Strings cannot update. If you want to get it to update you either need to make it a working formula or on workbook open look down column A for 'Active' then use the same 'DateDiff("d", Date, Target.Offset(, 2)) & " Dager igjen"' again.

 

[Fredrik1987]

Thanks for the input stemar, I've been wondering if it's easier to do this. Originally this was the solution I chose.
But there are more than one person who use the worksheet, and none of them are particularerly good with computers... So instead of me walking around the office all day if one of them deletes a cell/ moves it around etc. I chose to create a script to prevent these problems

Simply put: I want to put your formula into VBA.

 

[Fishboy]

Thanks for the input stemar, I've been wondering if it's easier to do this. Originally this was the solution I chose.
But there are more than one person who use the worksheet, and none of them are particularerly good with computers... So instead of me walking around the office all day if one of them deletes a cell/ moves it around etc. I chose to create a script to prevent these problems

Simply put: I want to put your formula into VBA.

Hi again Fredrik,

Try this out:

Private Sub Worksheet_Change(ByVal Target As Range)
' If more than one cell is updated at once exit sub
    If Target.Cells.Count > 1 Then Exit Sub
' If target column is A and row is greater than header row and target value is "Active" then...
        If Target.Column = 1 And Target.Row > 1 And Target.Value = "Active" Then
' Put today's date in column B of target row
            Target.Offset(0, 1).Value = Now()
        End If
' If target column is C and row is greater than header row and target value is not blank then...
            If Target.Column = 3 And Target.Row > 1 And Target.Value <> "" Then
' Apply formula to column D of target row, but evaluate and insert resulting value instead
                    Target.Offset(0, 1).Value = Application.Evaluate("=If(" & Target.Address & "="""",""""," & Target.Address & "-Today() & "" Dager igjen"")")
            End If
End Sub

 

[Fredrik1987]

Thank you for trying to help, I tried your solution.
I can't really see the difference between your script and mine, except that you use Now instead of Date, and (probably) a more effective way of refering to the cells.

Isn't there a way to simply use Sub Worksheet_Activate()?
I cant understand why it should be so difficult for VBA to insert a formula like the one stemar suggested and run it each time the worksheet activates?
Stemars suggestion: =if(C3="", "",C3-today() & " Dager igjen"

 

[Fishboy]

Thank you for trying to help, I tried your solution.
I can't really see the difference between your script and mine, except that you use Now instead of Date, and (probably) a more effective way of refering to the cells.

Isn't there a way to simply use Sub Worksheet_Activate()?
I cant understand why it should be so difficult for VBA to insert a formula like the one stemar suggested and run it each time the worksheet activates?
Stemars suggestion: =if(C3="", "",C3-today() & " Dager igjen"

The difference between yours and my code is that mine should should allow the number of days remaining to calculate automatically, as per your initial problem quoted below.

The problem is that column D, Days remaining doesn't update regularly.
I want it to count down the remaining number of days automatically.

Application.Evaluate("=If(" & Target.Address & "="""",""""," & Target.Address & "-Today() & "" Dager igjen"")") essentially means =if(C3="", "",C3-today() & " Dager igjen"), but is allowing C3 to update accordingly based on what row it is in.

I can't understand the new problem. It is doing what you asked. VBA is putting in the formula for you (albeit worded in a syntax allowing it reflect it's own position on the spreadsheet).

Every time you put Active into a cell in column A it automatically puts today's date in column B (Date Activated). If you then put in a deadline date in column C then column D automatically works out the days remaining. The way the formula has been created means it will actually change to reflect the passing of time (solving your issue from your first post).

The only thing the code doesn't do is to decide what the deadline should be by itself. You said you "usually" have 12 weeks. I can make it so the deadline date is automatically 12 weeks after the activation date if you prefer, however "usually" doesn't mean always, so there would be times the deadline was wrong, making the days remaining wrong. Manually entering a deadline date seems safer and still triggers the formula.

 

[Fredrik1987]

Hi again, I'm so sorry... You're absolutely right!
I'm used to recieving the deadline automatically by now, so I didn't even consider the possibility that the script didn't insert this automatically.
Again, my mistake.

But thank you so much for your help!! I'm also posting an alternate solution, but it includes a for-loop so I'm uncertain how effective it would be on larger arrays.

Sub Worksheet_Activate()

'' ======================================================================================================
'' ======================================================================================================
                                '' REMAINING DAYS (UPDATE ON STARTUP)
                                
Dim Saksnummer As Range
Set Saksnummer = Range("A2:A1000")
For Each cell In Saksnummer
    
    If Not cell.Value = "" Then
    
        cell.Offset(, 3).Value = DateDiff("d", Date, cell.Offset(, 2).Value) & " Dager igjen"

        End If
    
Next

End Sub