VBA code to email user when criteria is met

[Spartan300]

Hello,

I am using the following code so that an email is sent to a user when criteria is met.

Private Sub Worksheet_Calculate()
If Range("B1") < 30 Then
Range("A1:C1").Select
If Range("B1") < 30 Then
MsgBox ("Excel will now send an email to Senior management to inform then that the brochure amount is less than 30, when propted by excel select 'Allow' to send the email"), vbOKOnly + vbInformation
If Ans = vbOKOnly Then
GoTo Email
End If
End If
End If
Exit Sub
Email:
'Working in 2000-2007
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object
 
 
    Set Source = Nothing
    On Error Resume Next
    Set Source = Selection.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
 
    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
        Exit Sub
    End If
 
    If ActiveWindow.SelectedSheets.Count > 1 Or _
       Selection.Cells.Count = 1 Or _
       Selection.Areas.Count > 1 Then
        MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
               "You have more than one sheet selected." & vbNewLine & _
               "You only selected one cell." & vbNewLine & _
               "You selected more than one area." & vbNewLine & vbNewLine & _
               "Please correct and try again.", vbOKOnly
        Exit Sub
    End If
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
 
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
 
    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "Email address here"
            .CC = ""
            .BCC = ""
            .Subject = "Notification here"
            .Body = "For figure please see attached spreadsheet"
            .Attachments.Add Dest.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
 
    Kill TempFilePath & TempFileName & FileExtStr
 
    Set OutMail = Nothing
    Set OutApp = Nothing
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
 
    End With
End Sub

I did not write the code for the email, and because of this it works perfectly!

The problem I have is that if "B1"<30 an email is sent everytime that figure moves below 30 (e.g. from 26 to 23 etc.).

Ideally I want the email to be sent on the first occasion that the figure falls below 30, and if it keeps falling no email is sent.

Is this possible?

many thanks

 

[Andrew Poulsom]

You could use a static variable like this:

Private Sub Worksheet_Calculate()
    Static MailSent As Boolean
    If Range("B1") < 30 Then
        If Not MailSent = True Then
            MailSent = True
'           Replace next line with code to send mail
            MsgBox "Sending"
        End If
    End If
End Sub

 

[Spartan300]

Hi,

Thanks for your very quick reply!

The problem I have is that part of the spreadsheet must be selected as the email code copies this and attaches it to the email.

Private Sub Worksheet_Calculate()
If Range("B1") < 30 Then
Range("A1:C1").Select
If Range("B1") < 30 Then
MsgBox ("Excel will now send an email to Senior management to inform then that the brochure amount is less than 30, when propted by excel select 'Allow' to send the email"), vbOKOnly + vbInformation
If Ans = vbOKOnly Then
GoTo Email
End If
End If
End If
Exit Sub

THis code is the bit I wrote and it copies the sheet.

Sorry to be a pain but I am a complete novice. Is there away of incorporating the static code into this code?

Thanks

 

[Andrew Poulsom]

Here you are:

Private Sub Worksheet_Calculate()
    Static MailSent As Boolean
    If Range("B1") < 30 Then
        If Not MailSent = True Then
            MailSent = True
            Range("A1:C1").Select
            MsgBox ("Excel will now send an email to Senior management to inform then that the brochure amount is less than 30, when propted by excel select 'Allow' to send the email"), vbOKOnly + vbInformation
            GoTo EMail
        End If
    End If
    Exit Sub
EMail:
'   Replace next line with code to send mail
    MsgBox "Sending"
End Sub

 

[Spartan300]

Perfect again.

Thanks very much!