Thread: Automatic Email if value in range of cells < 30

Hi,

I've spent a couple of days on this but am a total novice so please excuse any nonsense that I write.

I've been to Ron de Bruin's site. Very helpful; I got the code below from him which sends starts another bit of successful code - email_via_Outlook. The automatic email part works fine. But it only checks the one cell (E3). I've tried getting it to look at E2:E10 but to no avail. Someone said on another forum that the line "If Target.Cells.Count > 1 Then Exit Sub" stops it from checking a range of cells. I want it to check E2 to E10. I also tried another bit of code which read E2:E10 but emailed every time the worksheet was opened; I only want one email sent for every time a line dips below 30. Can anyone help please?

Thanks in advance,
Andy

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
        On Error GoTo EndMacro
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Target.HasFormula Then
        Set rng = Target.Dependents
        If Not Intersect(Range("E3"), rng) Is Nothing Then
            If Range("E3").Value < 40 Then Mail_with_outlook
        End If
    End If

EndMacro:
End Sub

So what exactly are you looking to do ?

As the code stands presently whenever any cell on the worksheet is altered it checks to see if the updated cell contains a formula or not ... if it does not you then check to see if E3 is dependent upon the cell that has been altered and then if it is you subsequently check the value to see if it is less than 40 and if so you generate the email.

You're now saying you want to check to see if the target cell is a dependent cell of anyone of E2:E10 ... if it is what then - do you wish to check to see if any of the affected cells (E2:E10) are < 40 and then send an email, or send an email for each of the affected cells that dip below 40 ... not quite clear to me.

Re: Target.Count check... that simply stops the code firing if a batch of cells are changed simultaneously (ie you highlight F1:F10, type 10 into F1 and hit CTRL + ENTER) and thus it does not affect what you're trying to do
(based on my understanding)

Hi DonkeyOte,

Thanks for initiating a conversation.

Ok. I've attached the file in question. What I want to do is have an email sent to me when a certification gets to within 40 days of expiry (column E). But I only want it sent once, upon the first opening of the Spreadsheet since the expiry date got to the critical 40 day mark.

Ideally, I'd like the email generated to reference exactly which certification is going to expire soon.

PS I've never used VBA before but will endeavour to learn for future projects as it appears extremely useful (if you can get it to work).

Thank you.

Andy

OK so before coding anything let me just check I understand your requirements exactly.

File is opened -- review column E for any entries where value = 40 and send an email detailing the offending certification ?

I say = 40 because it's not clear if you want to get continual daily reminders once the 40 mark has been passed - ie should you today for ex. get an email re: row 3 where days to expiry is 2 or would the reminder you received 38 days ago have sufficed ?

Andy, try the below:

1 - add this to your ThisWorkbook object - note it makes use of a new column F which will hold a flag to indicate as to whether or not a reminder has already been issued for a given Cert

Private Sub Workbook_Open()
Dim wsCert As Worksheet, rngData As Range, rngCell As Range
Set wsCert = ThisWorkbook.Sheets("Cert Alert")
With wsCert
    Set rngData = .Range(Cells(1, "A"), Cells(.Rows.Count, "A").End(xlUp).Offset(, 5))
    With rngData
        .Calculate
        .AutoFilter field:=5, Criteria1:="<=40"
        .AutoFilter field:=6, Criteria1:=""
        For Each rngCell In .Columns(2).SpecialCells(xlCellTypeVisible).Cells
            If rngCell.Row > 1 Then
                Call Mail_with_outlook(rngCell)
                rngCell.Offset(, 4).Value = "Y"
            End If
        Next rngCell
        .AutoFilter
    End With
    Set rngData = Nothing
End With
Set wsCert = Nothing
End Sub

2 - remove the Worksheet_Change event from your code (or rename the routine to Worksheet_ChangeX such that it does not fire)

3 - Alter your mail routine slightly such that it reads:

Sub Mail_with_outlook(rngCert As Range)
Dim OutApp As Object, OutMail As Object
Dim strto As String, strcc As String, strbcc As String, strsub As String, strbody As String
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
strcc = ""
strbcc = ""
strsub = "Cert " & rngCert.Value & " Will Expire in 40 days"
strbody = "Dear All" & vbNewLine & vbNewLine & _
          "This is a test2"
With OutMail
    .To = "youraddress.com"
    .CC = strcc
    .BCC = strbcc
    .Subject = strsub
    .Body = strbody
    .Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

post the latest file which reflects the suggestions made previously.

As advised previously the Workbook_Open code should reside within the Workbook object namely "ThisWorkbook" not the Sheet Object... the opening of a workbook is a Workbook Level event as opposed to a Worksheet Level event.

Make the necessary alterations to your file, save, close & re-open the file and the open event should fire.

EDIT: You will also need to initially add a header to 'Cert Alert'!F1 in your file of "SENT" else the AutoFilter will fail

Re: Macro Security pre XL2007 versions this is set via Tools -> Macros -> Security.