VBA generates word docs, request to amend code to include description of deadlines/tasks due

[ttp921]

My VBA macro runs reports from Excel to generate a Word doc with upcoming deadlines/due dates. However, I can't figure out how to include a description of the upcoming deadlines/due dates when I run macros. Here are the columns that I need help with:

COLUMN A = MATTER NAME
COLUMN K = TASK DATE
COLUMN L = +/- DAYS
COLUMN M = TASK DUE
COLUMN N = TASK DUE DESCRIPTION

Currently, the code returns a result like this: SMITH, JOHN 4-16-2021 - TASK DUE - 9/23/2023. Is it possible to amend the code to include COLUMN N = TASK DUE DESCRIPTION so that the report looks like this instead: SMITH, JOHN 4-16-2021 - TASK DUE - 9/23/2023 - TASK DUE DESCRIPTION - CALL CLIENT?

I've uploaded a copy of the Excel sheet along with an example of the generated Woc doc report. Here's the code that I am currently using:

Sub Due_Date()
Dim DueDate_Col As Range
Dim Due As Range
Dim PopUp_Notification As String
Set DueDate_Col = Range("J2:J500,D2:D500,D2:D500,M2:M500")
For Each Due In DueDate_Col
If Due <> "" And Date >= Due - Range("S2") Then
PopUp_Notification = PopUp_Notification & vbCrLf & Cells(Due.Row, "A") & " - " & Cells(1, Due.Column) & " - " & Due.Value
End If

Next Due
If PopUp_Notification = "" Then
MsgBox "No outstanding tasks/SOLs due."
Else
Dim WordApp As Object
Dim WDoc As Object
'
'Create Word.Application
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
Err.Clear
End If
On Error GoTo 0
WordApp.Visible = True
Set WDoc = WordApp.Documents.Add
WDoc.Range(0, 0).Text = PopUp_Notification
WordApp.Activate
End If
End Sub

CASE DEADLINES EXCEL.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	MATTER NAME	INCIDENT DATE	+/- YRS	SOL EXP. DATE	DISPOSED DATE	NEW SOL EXP. DATE	SUB-STATUS	LAST CONTACT DATE	+/- DAYS	CLT CONTACT DUE	TASK DATE	+/- DAYS	TASK DUE	TASK DUE DESCRIPTION
2	SMITH, JOHN 4-16-2021	4/16/2021	2	4/16/2023	10/27/2021	10/27/2023	INTAKE	9/28/2023	30	10/28/2023	8/24/2023	30	9/23/2023	CALL CLIENT
3	SMITH, JANE 05-15-2021	05/15/2021	2	5/15/2023	3/30/2022	3/30/2024	INTAKE	9/27/2023	2	9/29/2023	9/27/2023	2	9/29/2023	CALL CLIENT AND GET ADDITIONAL INFORMATION
4	SMITH, CHRIS 05-15-2021	05/15/2021	2	5/15/2023	3/30/2022	3/30/2024	CLOSE FILE	9/27/2023	30	10/27/2023	8/24/2023	30	9/23/2023	CALL CLIENT TO CLOSE FILE
Sheet 1

Cell Formulas
Range	Formula
D2:D4	D2	=DATE(YEAR(B2)+C2,MONTH(B2),DAY(B2))
F2:F4	F2	=DATE(YEAR(E2)+C2,MONTH(E2),DAY(E2))
J2:J4,M2:M4	J2	=H2+I2

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
M:M	Cell Value	<TODAY()	text	NO
M:M	Cell Value	=TODAY()	text	NO
M:M	Cell Value	between TODAY() and TODAY()+5	text	NO
M:M	Cell Value	>TODAY()	text	NO
D:D	Cell Value	<TODAY()	text	NO
J:J	Cell Value	<TODAY()	text	NO
J:J	Cell Value	=TODAY()	text	NO
D:D	Cell Value	=TODAY()	text	NO
D:D	Cell Value	between TODAY() and TODAY()+30	text	NO
J:J	Cell Value	between TODAY() and TODAY()+30	text	NO
D:D	Cell Value	between TODAY() and TODAY()+90	text	NO
D:D	Cell Value	between TODAY() and TODAY()+180	text	NO
D:D	Cell Value	>TODAY()	text	NO
J:J	Cell Value	between TODAY() and TODAY()+90	text	NO
J:J	Cell Value	between TODAY() and TODAY()+180	text	NO
J:J	Cell Value	>=TODAY()+1	text	NO

 

[NateSC]

A couple of things I noticed:
- It loops through 500 rows. This could be improved to only run through the number of rows that have data. Are there ever blank cells in column A followed by valid data in lower rows? (i.e. row 10 would have nothing in A10 and then row 11 and below might have more data)
- When the code generates the PopUp_Notification, it uses Due.Value. When it does this, it gives you the date from Column J (CLT Contact Due) and not Column M (Task Due). Is this the correct date? Your example above suggested otherwise.

Assuming you don't want to change any of the above issues, you would change 1 line:

PopUp_Notification = PopUp_Notification & vbCrLf & Cells(Due.Row, "A") & " - " & Cells(1, Due.Column) & " - " & Due.Value & " - " & Cells(1, "N") & " - " & Cells(Due.Row, "N")

If you want it to actually reference the TASK DUE (Column M) you would change it to:

PopUp_Notification = PopUp_Notification & vbCrLf & Cells(Due.Row, "A") & " - " & Cells(1, "M") & " - " & Cells(Due.Row, "M") & " - " & Cells(1, "N") & " - " & Cells(Due.Row, "N")

There are some other streamlining things that could be done if it runs slow, but if speed is not an issue it might not be worth messing with.

 

[ttp921]

A couple of things I noticed:
- It loops through 500 rows. This could be improved to only run through the number of rows that have data. Are there ever blank cells in column A followed by valid data in lower rows? (i.e. row 10 would have nothing in A10 and then row 11 and below might have more data)
- When the code generates the PopUp_Notification, it uses Due.Value. When it does this, it gives you the date from Column J (CLT Contact Due) and not Column M (Task Due). Is this the correct date? Your example above suggested otherwise.

Assuming you don't want to change any of the above issues, you would change 1 line:

PopUp_Notification = PopUp_Notification & vbCrLf & Cells(Due.Row, "A") & " - " & Cells(1, Due.Column) & " - " & Due.Value & " - " & Cells(1, "N") & " - " & Cells(Due.Row, "N")

If you want it to actually reference the TASK DUE (Column M) you would change it to:

PopUp_Notification = PopUp_Notification & vbCrLf & Cells(Due.Row, "A") & " - " & Cells(1, "M") & " - " & Cells(Due.Row, "M") & " - " & Cells(1, "N") & " - " & Cells(Due.Row, "N")

There are some other streamlining things that could be done if it runs slow, but if speed is not an issue it might not be worth messing with.

Thank you for your response! In Column A, there are not usually any blank cells. I believe it's coded for 500 rows for any new clients that are added to my sheet. Regarding your second question, I wanted the code to generate 3 dates and descriptions, using these columns:

COLUMN D = SOL EXPIRATION DATE
COLUMN J = CLT CONTACT DUE
COLUMN M = TASK DUE
COLUMN N = TASK DUE DESCRIPTION

As such, I used your code to replace line 1 and it works (huzzah!)! The word doc report now shows the task due description, however, it creates two different entries by splitting the contacts and the tasks due into two separate sections on the report instead of showing both dates (COLUMN J and COLUMN N) on the same line. Here's what it looks like:

SMITH, CHRIS 05-15-2021 - CLT CONTACT DUE - 10/27/2023 - TASK DUE DESCRIPTION - CALL CLIENT TO CLOSE FILE
SMITH, CHRIS 05-15-2021 - TASK DUE - 9/23/2023 - TASK DUE DESCRIPTION - CALL CLIENT TO CLOSE FILE

Would it be possible to either include both due dates in a single line like this: SMITH, CHRIS 05-15-2021 - CLT CONTACT DUE - 10/27/2023 - TASK DUE - 9/23/2023 - TASK DUE DESCRIPTION - CALL CLIENT TO CLOSE FILE?

Note, the report currently separates out COLUMN D into its own section and that is okay with me. I was more concerned about getting the description to generate in the report.

Thank you very much for your help!

 

[NateSC]

Make sure you only have 1 PopUp_Notification statement. To do what you were asking for, you should be able to replace the PopUp_Notification with:

            PopUp_Notification = PopUp_Notification & vbCrLf & Cells(Due.Row, "A") & " - " & Cells(1, "J") & " - " & Cells(Due.Row, "J") _
                & " - " & Cells(1, "M") & " - " & Cells(Due.Row, "M") & " - " & Cells(1, "N") & " - " & Cells(Due.Row, "N")

The whole sub would be:

Sub Due_Date()
Dim DueDate_Col As Range
Dim Due As Range
Dim PopUp_Notification As String
    
    Set DueDate_Col = Range("J2:J500,D2:D500,D2:D500,M2:M500")
    For Each Due In DueDate_Col
        If Due <> "" And Date >= Due - Range("S2") Then
            PopUp_Notification = PopUp_Notification & vbCrLf & Cells(Due.Row, "A") & " - " & Cells(1, "J") & " - " & Cells(Due.Row, "J") _
                & " - " & Cells(1, "M") & " - " & Cells(Due.Row, "M") & " - " & Cells(1, "N") & " - " & Cells(Due.Row, "N")
        End If
    Next Due
    If PopUp_Notification = "" Then
        MsgBox "No outstanding tasks/SOLs due."
    Else
    Dim WordApp As Object
    Dim WDoc As Object
    '
    'Create Word.Application
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set WordApp = CreateObject("Word.Application")
        Err.Clear
    End If
    On Error GoTo 0
    WordApp.Visible = True
    Set WDoc = WordApp.Documents.Add
    WDoc.Range(0, 0).Text = PopUp_Notification
    WordApp.Activate
    End If
End Sub

If you need to add Column D, that would be this sub:

Sub Due_Date()
Dim DueDate_Col As Range
Dim Due As Range
Dim PopUp_Notification As String
    
    Set DueDate_Col = Range("J2:J500,D2:D500,D2:D500,M2:M500")
    For Each Due In DueDate_Col
        If Due <> "" And Date >= Due - Range("S2") Then
            PopUp_Notification = PopUp_Notification & vbCrLf & Cells(Due.Row, "A") & " - " & Cells(1, "D") & " - " & Cells(Due.Row, "D") _
                & " - " & Cells(1, "J") & " - " & Cells(Due.Row, "J") & " - " & Cells(1, "M") & " - " & Cells(Due.Row, "M") & " - " & Cells(1, "N") & " - " & Cells(Due.Row, "N")
        End If
    Next Due
    If PopUp_Notification = "" Then
        MsgBox "No outstanding tasks/SOLs due."
    Else
    Dim WordApp As Object
    Dim WDoc As Object
    '
    'Create Word.Application
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set WordApp = CreateObject("Word.Application")
        Err.Clear
    End If
    On Error GoTo 0
    WordApp.Visible = True
    Set WDoc = WordApp.Documents.Add
    WDoc.Range(0, 0).Text = PopUp_Notification
    WordApp.Activate
    End If
End Sub

 

[ttp921]

Thanks so much for all of your help! Is there anyway to have the report generate the deadlines in COLUMN N and COLUMN J in chronological order? It is difficult sort and prioritize the tasks due in the generated report.