none
Elapsed Days from Start to Stop, Excel RRS feed

  • Question

  • The following code correctly calculates the elapsed days from "Start" (column "A") and shows the results in column "C".

    When a "Stop" date is entered into column "B", I would like the total number of elapsed days (comparing columns "A" and "B") to be shown in column "C".

    Here is my code:

    =======================================================

    Private Sub Worksheet_Change(ByVal Target As Excel.Range)

        Dim N As Long
        On Error GoTo enditall
        
    Application.ScreenUpdating = False
        
        Application.EnableEvents = False
        If Target.Cells.Column = 1 Then
            N = Target.Row

            If Excel.Range("A" & N).Value <> "" Then
                Excel.Range("C" & N).Value = Format(Now - Range("A" & N).Value, "0")
         
            End If
        End If
    enditall:
        Application.EnableEvents = True

    Application.ScreenUpdating = True

    End Sub

    =======================================================

    Thanks in advance for any assistance you could provide.

    Rich

    Friday, October 9, 2015 8:15 AM

Answers

  • The following version will also work if you change multiple cells at once:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rw As Range
        Dim r As Long
        If Not Intersect(Range("A:B"), Target) Is Nothing Then
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            For Each rw In Intersect(Range("A:B"), Target)
                r = rw.Row
                If Range("A" & r).Value = "" Then
                    Range("C" & r).ClearContents
                ElseIf Range("B" & r).Value = "" Then
                    Range("C" & r).Value = Date - Range("A" & r).Value
                Else
                    Range("C" & r).Value = Range("B" & r).Value - Range("A" & r).Value
                End If
            Next rw
            Application.EnableEvents = True
            Application.ScreenUpdating = True
        End If
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by RichMWilliams Friday, October 9, 2015 3:02 PM
    Friday, October 9, 2015 10:24 AM

All replies

  • The following version will also work if you change multiple cells at once:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rw As Range
        Dim r As Long
        If Not Intersect(Range("A:B"), Target) Is Nothing Then
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            For Each rw In Intersect(Range("A:B"), Target)
                r = rw.Row
                If Range("A" & r).Value = "" Then
                    Range("C" & r).ClearContents
                ElseIf Range("B" & r).Value = "" Then
                    Range("C" & r).Value = Date - Range("A" & r).Value
                Else
                    Range("C" & r).Value = Range("B" & r).Value - Range("A" & r).Value
                End If
            Next rw
            Application.EnableEvents = True
            Application.ScreenUpdating = True
        End If
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by RichMWilliams Friday, October 9, 2015 3:02 PM
    Friday, October 9, 2015 10:24 AM
  • Thanks Hans!

    Your solution is perfect.  Thanks for such a quick response!

    Best regards,

    Rich

    Friday, October 9, 2015 3:03 PM