Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Send an email based on value in a cell only when workbook is saved

Tags:

excel

vba

I have a cell B8 that checks to see if data has been entered in a range of cells for the day and outputs a number depending on the count. It checks for blank entries and obviously at the start of filling out the sheet all the cells for the day will be blank, I want it to only perform the check once the worksheet has been saved.

The code I've managed to Frankenstein together prepares an email the instant the condition is met and I'm not sure how to change it to suit my needs.

Sub Mail_with_outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim emlto As String, emlcc As String, emlbcc As String
Dim emlsub As String, emlbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

emlto = "[email protected]"
emlcc = ""
emlbcc = ""
emlsub = "Raw Material Projection"
emlbody = "Good Day" & vbNewLine & vbNewLine & _
          "There might be an issue with the data inputed in today's sheet"


With OutMail
    .To = emlto
    .CC = emlcc
    .BCC = emlbcc
    .Subject = emlsub
    .Body = emlbody
    .Display    '  use .Send once tested
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub





Private Sub Worksheet_Calculate()
Dim FormulaRange As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim MyLimit As Double

NotSentMsg = "Not Sent"
SentMsg = "Sent"

'Above the MyLimit value it will run the macro
MyLimit = 10

'range with the Formula that I want to check
Set FormulaRange = Me.Range("B8")

On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
        If IsNumeric(.Value) = False Then
            MyMsg = "Not numeric"
        Else
            If .Value > MyLimit Then
                MyMsg = SentMsg
                If .Offset(0, 1).Value = NotSentMsg Then
                    Call Mail_with_outlook
                End If
            Else
                MyMsg = NotSentMsg
            End If
        End If
        Application.EnableEvents = False
        .Offset(0, 1).Value = MyMsg
        Application.EnableEvents = True
    End With
Next FormulaCell

ExitMacro:
Exit Sub

EndMacro:
Application.EnableEvents = True

MsgBox "Some Error occurred." _
     & vbLf & Err.Number _
     & vbLf & Err.Description

End Sub
like image 309
LafaMan Avatar asked Dec 05 '25 22:12

LafaMan


1 Answers

I would put your logic in a BeforeSave event.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   'your logic goes here
End Sub

If you are only checking if there is now something in the range, whereas before it was completely empty, consider using the COUNTA/COUNT functions.

Notes:

Occurs before the workbook is saved.

Syntax expression. BeforeSave( SaveAsUI , Cancel )

expression A variable that represents a Workbook object.

Parameters

SaveAsUI: Required, Boolean, Description: True if the Save As dialog box will be displayed due to changes made that need to be saved in the workbook.

Cancel: Required, Boolean, Description: False when the event occurs. If the event procedure sets this argument to True , the workbook isn't saved when the procedure is finished.

like image 143
QHarr Avatar answered Dec 08 '25 12:12

QHarr