Gmayor,
I added to your code to highlight and copy the date.
It also displays a message in the Status Bar.
Here it is:
Sub Macro2()
'
'Sub Macro1()
Dim strBothItems As String
Dim firstPart As String
Dim datePart As String
firstPart = "Fifteen Days from Today "
datePart = Format(DateDue(Date, 15), "mm-dd-yyyy")
strBothItems = firstPart & datePart
Selection.TypeText Format(DateDue(Date, 15), "mm-dd-yyyy")
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
Application.StatusBar = strBothItems
‘Application.StatusBar = Format(DateDue(Date, 15), "mm-dd-yyyy")
'Application.StatusBar = "Fifteen Days from Today "
End Sub

Public Function DateDue(ByVal vDate As Date, ByVal iDays As Variant) As Variant
'Graham Mayor - http://www.gmayor.com - Last updated - 14 May 2017
'Add weekdays to date - from Monday if date falls at weekend
Dim iCount As Integer

DateDue = Null
If IsNull(vDate) Or IsNull(iDays) Then
GoTo lbl_Exit
End If

Select Case Weekday(vDate)
Case Is = 1 ' Sunday
vDate = DateAdd("d", 1, vDate)
iCount = 0
Case Is = 7 ' Saturday
vDate = DateAdd("d", 2, vDate)
iCount = 0
Case Else
iCount = Weekday(vDate) - 2
End Select

iDays = iDays + iCount
vDate = DateAdd("d", iCount * -1, vDate)
DateDue = DateAdd("d", iDays Mod 5, DateAdd("ww", Int(iDays / 5), vDate))
lbl_Exit:
Exit Function
End Function