Contracts Expiry Email Via Excel

What information do you want included in the email? Just the contract name & expiry date
Do you want a single email that contains all the contracts due to expire.

Your request implies others are completing the workbook, or else surely you could just add an extra column that identifies a contract will be expiring in <2 months and filter on that column.
So what event should trigger that macro? Perhaps a 'Before_Save' or a 'Before_Close' event?

What event should start the process of producing the email and sending to you.

ARe you expecting someone to manually click a button or should this be automatic when someone chooses to save or close the workbook. Bear in mind with the save event you would get an email evey time someone saved the current workbook after adding stuff and then continued to add more data & save again.....etc.

What about an expiry date that is prior to the current date e.g. 31/3/2019 in H11. Should that be reported?

Other than that none of the other expiry dates are less than two months away so it appears this is bad test example.
However please confirm that as it is currently presented you wouldn't expect to receive an email. I'll change some of the dates for testing purposes.

For clarification purposes are you defining Expired contracts as any contract with a date in column H that predates the Current Date.

That was the behind my question in post #6

RE your question about adding an additional column after supplier. As I've previously written the macro then yes that would have an effect since it shifts the Expiry date column across. That's not a problem now you've mentioned it so I have catered for this in the code below

It then depends whether any additional column you add contains information that you want to report in an eMail. If so that's more problematic, particularly if there were any conditions attached to whether to report it or not. For now you should work on the assumption that the code would need modifying if you needed to report the information from any additional column in the email.

If you know now what you might want to add as an extra column then it might be preferable to add it now for use later and hide the column if necessary. And in addition say whether in due course when you start to use that column whether you want the information included in the Email.

Just a thought. Rather than two buttons to run either the forthcoming expiry dates or already expired contracts, why not include both in a single email. The first part of the email could be all the forthcoming expiry dates and these would be followed by the Expired Contracts

The attached workbook contains the following macros.
It also contains a range name for the current column H. This will adjust should you add an extra column prior to column H and the macro will continue to run.

Edit your email address where I show the .TO line of code highlighted in red

Sub SendExpiryEmail()
    Dim stemail As String, lRow As Long, x As Long, stExpCol As String, lExpCol As Long
    

    lExpCol = Range("ExpColumn").Column
    stExpCol = Split(Cells(1, lExpCol).Address, "$")(1)
    lRow = Sheet1.Range("H" & Rows.Count).End(xlUp).Row
    stemail = "These Contracts will expire in less than two months" & Chr(10) & Chr(10) & "Number" & " :  " & "      Supplier" & " : " & "     Expiry Date" & Chr(10)
    For x = 9 To lRow
        If WorksheetFunction.EDate(Sheet1.Range(stExpCol & x), -2) <= Date Then
            stemail = stemail & Sheet1.Range("B" & x) & "     :   " & Sheet1.Range("E" & x) & "    :  " & Sheet1.Range("H" & x) & Chr(10)
        End If
        'stemail = stemail & Chr(10)
    Next
    
    Call Module1.Email(stemail, "These contracts will expire within two months")
    stemail = ""
End Sub

Sub SendExpiredEmail()
    Dim stemail As String, lRow As Long, x As Long, stExpCol As String, lExpCol As Long
    
    lExpCol = Range("ExpColumn").Column
    stExpCol = Split(Cells(1, lExpCol).Address, "$")(1)
    lRow = Sheet1.Range("H" & Rows.Count).End(xlUp).Row
    stemail = "These are expired Contracts" & Chr(10) & Chr(10) & "Number" & " :  " & "      Supplier" & " : " & "     Expiry Date" & Chr(10)
    For x = 9 To lRow
        If Sheet1.Range(stExpCol & x) <= Date Then
            stemail = stemail & Sheet1.Range("B" & x) & "     :   " & Sheet1.Range("E" & x) & "    :  " & Sheet1.Range("H" & x) & Chr(10)
        End If
        'stemail = stemail '& Chr(10)
    Next
      
    Call Module1.Email(stemail, "These are expired contracts")
    stemail = ""
End Sub

Sub Email(stemail As String, stSubject As String)
Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "your email address"
        .Subject = stSubject
        .Body = stemail
        .Send   'or use .Display
        '.display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing



End Sub

Hi,

Re the EDate function.
Are you using the workbook I sent you or have you copied the macros I sent into another workbook?

If so did you remember to add the Range name that I mentioned in post #8.

i..e the range name "ExpColumn" which refers to $H$8

Does the data start on row 9? If not adjust the x loop counter which starts at 9 in the line of code to whatever is the first row of data.

[FORMULA]For x = 9 To lRow[/FORMULA.

If neither of the above fix the problem plese upload the workbook you are using,