Sub Macro45()
Dim oRng As Word.Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = "[0-9]{1,2}\/"
    .MatchWildcards = True
    If .Execute Then
      oRng.End = oRng.Paragraphs(1).Range.End - 1
      If IsDate(oRng.Text) Then
        ActiveDocument.Range.InsertAfter "It took this long: " & fcnCalcSpanStart_Finish(oRng.Text, Now)
      End If
    End If
  End With
lbl_Exit:
  Exit Sub
End Sub
Function fcnCalcSpanStart_Finish(oDateStart As Date, oDateNow As Date)
'A VBA Function coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 7/27/2017
Dim lngYear As Long, lngMonth As Long, lngDay As Long, lngHour As Long, lngMinute As Long, lngSecond As Long
Dim lngIndex As Long
Dim oDateLDPM As Date, oDateLDIM As Date, oAnchorDate As Date
Dim dtdHMSCalc As Date
Dim strHMS As String
Dim arrStringParts() As String
  If oDateStart > oDateNow Then
    fcnCalcSpanStart_Finish = "The start date passed much be prior to date now."
    Exit Function
  End If
  'Calculate complete years passed.
  If Year(oDateNow) > Year(oDateStart) Then
    'A different calendar year. Has one or more complete years passed?
    If Month(oDateNow) = Month(oDateStart) Then
      'Same month in subsequent year. Check day.
      If Day(oDateNow) >= Day(oDateStart) Then
        'Complete year passed
        lngYear = DateDiff("yyyy", oDateStart, oDateNow)
      Else
        lngYear = DateDiff("yyyy", oDateStart, oDateNow) - 1
      End If
    ElseIf Month(oDateNow) > Month(oDateStart) Then
      'Complete year passed.
      lngYear = DateDiff("yyyy", oDateStart, oDateNow)
    Else
      lngYear = DateDiff("yyyy", oDateStart, oDateNow) - 1
    End If
  Else
    'Obviously no commplete year passed.
    lngYear = 0
  End If
  'Calculate full months passed from last full year.
  lngMonth = (DateDiff("m", DateSerial(Year(oDateStart), Month(oDateStart), 1), _
              DateSerial(Year(oDateNow), Month(oDateNow), 1)) + IIf(Day(oDateNow) >= Day(oDateStart), 0, -1)) Mod 12
  'Calculate number of days passed from last full month.
  If Day(oDateNow) >= Day(oDateStart) Then
    lngDay = Day(oDateNow) - Day(oDateStart)
  Else
    'Calculate for end of month.
    'Get date on last day of previous month.
    oDateLDPM = DateSerial(Year(oDateNow), Month(oDateNow), 0)
    'Get date on last day of index month.
    oDateLDIM = DateSerial(Year(oDateNow), Month(oDateNow) + 1, 0)
    oAnchorDate = DateSerial(Year(oDateNow), Month(oDateNow) - 1, Day(oDateStart))
    If oDateLDIM = oDateNow Then
      If lngMonth = 11 Then
        'Reset month and add a year.
        lngMonth = 0
        lngYear = lngYear + 1
      Else
        lngMonth = lngMonth + 1
      End If
    Else
      lngDay = DateDiff("d", IIf(oAnchorDate > oDateLDPM, oDateLDPM, oAnchorDate), oDateNow)
    End If
  End If
  'Calculate hours, minutes and seconds.
  If TimeValue(oDateStart) > TimeValue(oDateNow) Then lngDay = lngDay - 1
  dtdHMSCalc = oDateNow - oDateStart
  lngHour = Hour(dtdHMSCalc)
  lngMinute = Minute(dtdHMSCalc)
  lngSecond = Second(dtdHMSCalc)
  
  'Format returned value.
  fcnCalcSpanStart_Finish = lngYear & IIf(lngYear = 1, " year, ", " years, ") & lngMonth & IIf(lngMonth = 1, " month, ", _
                 " months, ") & lngDay & IIf(lngDay = 1, " day", " days")
  fcnCalcSpanStart_Finish = Replace(fcnCalcSpanStart_Finish, "0 years", "")
  fcnCalcSpanStart_Finish = Replace(fcnCalcSpanStart_Finish, ", 0 months", "")
  fcnCalcSpanStart_Finish = Replace(fcnCalcSpanStart_Finish, ", 0 days", "")
  strHMS = lngHour & IIf(lngHour = 1, " hour, ", " hours, ") & lngMinute & IIf(lngMinute = 1, " minute, ", _
                 " minutes, ") & lngSecond & IIf(lngSecond = 1, " second", " seconds")
      
  If fcnCalcSpanStart_Finish <> vbNullString Then
    fcnCalcSpanStart_Finish = fcnCalcSpanStart_Finish & ", " & strHMS
  Else
    fcnCalcSpanStart_Finish = strHMS
  End If
  fcnCalcSpanStart_Finish = Replace(fcnCalcSpanStart_Finish, "0 hours", "")
  fcnCalcSpanStart_Finish = Replace(fcnCalcSpanStart_Finish, ", 0 minutes", "")
  fcnCalcSpanStart_Finish = Replace(fcnCalcSpanStart_Finish, ", 0 seconds", "")
  arrStringParts = Split(fcnCalcSpanStart_Finish, ", ")
   If UBound(arrStringParts) > 0 Then
     If UBound(arrStringParts) = 1 Then
       fcnCalcSpanStart_Finish = Replace(fcnCalcSpanStart_Finish, ", ", " and ")
     Else
       fcnCalcSpanStart_Finish = vbNullString
       For lngIndex = 0 To UBound(arrStringParts)
         Select Case True
           Case lngIndex <= UBound(arrStringParts) - 2
             fcnCalcSpanStart_Finish = fcnCalcSpanStart_Finish & arrStringParts(lngIndex) & ", "
           Case lngIndex <= UBound(arrStringParts) - 1
             fcnCalcSpanStart_Finish = fcnCalcSpanStart_Finish & arrStringParts(lngIndex) & " and "
           Case Else
             fcnCalcSpanStart_Finish = fcnCalcSpanStart_Finish & arrStringParts(lngIndex) & "."
         End Select
       Next lngIndex
     End If
    End If
lbl_Exit:
  Exit Function
End Function