Automatic Email Generation

[DM236]

Greetings,

I have a PO log sheet in excel. I want this excel sheet to automatically e-mail a user a list of open PO's, as long as conditions are met.

The sheet has many columns, but of importance is column A, column C, Column O, and Column Q.

In column A, the date the PO was submitted is listed.
In column C, the PO# is listed.
In column O, the date received is listed. If not received yet, cell is blank.
In Column Q, I have a simple ifand function which returns 1 if PO has not been received and it was submitted 30 days or more ago. It returns 0 if not.

I would like the sheet to email the list of PO's that have not been received and are 30 days or older (AKA column Q will return 1).

Currently, this is my VBA code (which I've basically copied and modified very slightly):

Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("Q190"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value > 0 Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

xMailBody = "Please followup on PO Number" & Range("C190").Value

On Error Resume Next
With xOutMail
.To = "xxxxxx@xxxxxxxx; xxxxxxx@xxxxxxxx"
.CC = ""
.BCC = ""
.Subject = "Please follow up on PO" & Range("C190").Value
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub


This works for basically one row (row 190). As mentioned, I would like it to scan the entire column Q, and send a list with all PO, not just the one cell.

Very grateful for any help or guidance. Thank you.

 

[mumps]

A Worksheet_Change event will not trigger if the the change in column Q is the result of a formula. Do you want to send the email each time any value in column Q changes to a "1" or would it be easier and more practical if you ran a macro manually or by clicking a button on your sheet each time you wanted the email to be generated? This way you can control when the email is generated instead of having it generated automatically with an event macro.

 

[DM236]

Hi Mumps!

Thank you so much for taking the time to reply.

It would be easiest to create a simple button.

 

[mumps]

Create a button on your sheet and assign this macro to it. The macro assumes you have headers in row 1 and your data starts in row 2 with no blank rows.

Sub CreateEmail()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, xMailBody As String, rng As Range, val As String
    xMailBody = "Please follow up on the PO Numbers below:"
    With Range("A1")
        .CurrentRegion.AutoFilter 17, "1"
        For Each rng In Range("C2", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
            If val = "" Then val = rng Else val = val & ", " & rng
        Next rng
        .AutoFilter
    End With
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .to = "xxxxxx@xxxxxxxx; xxxxxxx@xxxxxxxx"
        .CC = ""
        .BCC = ""
        .Subject = "Please follow up on the listed PO Numbers."
        .HTMLBody = xMailBody & "<br><br>" & val
        .Display 'or use .Send
    End With
    Application.ScreenUpdating = True
End Sub

 

[DM236]

Hi Mumps

I inserted a simple command button. When I created the button, I see the following code generated in VBA:

Private Sub Commandbutton1_Click()

End Sub

Then, to insert the code, I simply copied and pasted your code into the sub routine. So, my code looks like this now:

Private Sub CommandButton1_Click()
Sub CreateEmail()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, xMailBody As String, rng As Range, val As String
    xMailBody = "Please follow up on the PO Numbers below:"
    With Range("A1")
        .CurrentRegion.AutoFilter 17, "1"
        For Each rng In Range("C2", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
            If val = "" Then val = rng Else val = val & ", " & rng
        Next rng
        .AutoFilter
    End With
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .to = "xxxxxx@xxxxxxxx; xxxxxxx@xxxxxxxx"
        .CC = ""
        .BCC = ""
        .Subject = "Please follow up on the listed PO Numbers."
        .HTMLBody = xMailBody & "<br><br>" & val
        .Display 'or use .Send
    End With
    Application.ScreenUpdating = True
End Sub
End Sub

When pressing the button, I receive an error "Compile Error: Expected end sub"

In case it isn't obvious, I have never actually used VBA for anything. I'm only familiar with recording Macros in excel. I did remove the initial code I posted from the sheet.

Thanks so much for your insight.

 

[mumps]

Try:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, xMailBody As String, rng As Range, val As String
    xMailBody = "Please follow up on the PO Numbers below:"
    With Range("A1")
        .CurrentRegion.AutoFilter 17, "1"
        For Each rng In Range("C2", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
            If val = "" Then val = rng Else val = val & ", " & rng
        Next rng
        .AutoFilter
    End With
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .to = "xxxxxx@xxxxxxxx; xxxxxxx@xxxxxxxx"
        .CC = ""
        .BCC = ""
        .Subject = "Please follow up on the listed PO Numbers."
        .HTMLBody = xMailBody & "<br><br>" & val
        .Display 'or use .Send
    End With
    Application.ScreenUpdating = True
End Sub

 

[DM236]

Hi Mumps!

I tried your revised code. I am now receiving the error "Run-time error '1004': Autofilter method or Range class failed". Thanks for your continued efforts, and please excuse my lack of experience / poorly phrased responses.

Code below

Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, xMailBody As String, rng As Range, val As String
    xMailBody = "Please follow up on the PO Numbers below:"
    With Range("A1")
        .CurrentRegion.AutoFilter 17, "1"
        For Each rng In Range("C2", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
            If val = "" Then val = rng Else val = val & ", " & rng
        Next rng
        .AutoFilter
    End With
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .to = "xxxxxx@xxxxxxxx; xxxxxxx@xxxxxxxx"
        .CC = ""
        .BCC = ""
        .Subject = "Please follow up on the listed PO Numbers."
        .HTMLBody = xMailBody & "<br><br>" & val
        .Display 'or use .Send
    End With
    Application.ScreenUpdating = True
End Sub

 

[mumps]

The macro assumes that you have headers in row 1, that your data starts in row 2 with no blank rows and that the "1 values are in column Q. If this is the case, it would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).