Search code examples
excelvba

VBA macro to return the difference between first and last edited dates of a cell

I do a lot of follow up work that requires to extract some KPIs. One of these is the Process Adherence. It is basically the subtraction of two dates, these being the date a process is planned to end minus the date the process actually ended.

In excel, I have a worksheet I input the date of every process a part is subject to (See below)

enter image description here

We can assume the first date inputed is the planned one and all dates after this are the reschedules of said process.

I managed to make a VBA code to store all modifications of a cell in a note, but now I need a code that can take the first date stored in the note and the current value of the cell, subtract it and give me the result of this operation in Sheet 2.

enter image description here

Can anyone help me to achieve what I'm after? Thanks

The code I have for storing all modifications of a cell as a note.

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If Target.Column <> 13 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
Dim strNewText$, strCommentOld$, strCommentNew$
strNewText = .Text
If Not .Comment Is Nothing Then
strCommentOld = .Comment.Text & Chr(10) & Chr(10)
Else
strCommentOld = ""
End If
On Error Resume Next
.Comment.Delete
Err.Clear
.AddComment
.Comment.Visible = False
.Comment.Text Text:=strCommentOld & _
Format(VBA.Now, "MM/DD/YYYY at h:MM AM/PM") & " - " & Application.UserName & Chr(10) & strNewText
.Comment.Shape.TextFrame.AutoSize = True
End With
End Sub
Solution

  • For example as a user-defined function:

    Function FirstDateEntered(c As Range)
    Dim txt, arr, el, dt
    If Not c.Comment Is Nothing Then 'cell has comment?
        txt = c.Comment.Text
        arr = Split(txt, vbLf)  'split text to lines
        For Each el In arr      'loop resulting array
            If IsDate(el) Then
                FirstDateEntered = DateValue(el)
                Exit Function 'done checking
            End If
        Next el
    End If
    FirstDateEntered = ""
End Function