By Jake on Thursday, 17 February 2022
Posted in Excel
Replies 1
Likes 0
Views 5.6K
Votes 0
So I used this excellent article How to automatically send email based on cell value in Excel? (extendoffice.com) and scrapped together answers from the replies to get this working as I need it to but the last piece I can't figure out is how to duplicate what I've done to run for multiple cells. I've tried to copy/paste and rearrange the code with different values like C4, C5, etc. but I always get errors. I have it working great to where if the value in C3 is < 5 it will send an email when the workbook is saved.What I need now, since this is for an inventory sheet, is to have multiple other cell values checked at different values. For example, if only C3 < 5 send an email. If only C4 is < 6 send an email. If C3 < 5, C4 is < 6 and C5 < 3 send an email. It would be nice if only one email is generated on save with all of the values that matched the < criteria.In real-world terms (not coding terms), the spreadsheet is a place for technicians to check in and out items from storage. What I am trying to do is have an email automatically sent when someone saves the workbook and the inventory level of an item has dropped below a specific value so I know that an order needs to be placed soon. So far this is my code:

ThisWorkbook
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
On Error Resume Next
Dim xI As Integer
Dim xRg As Range
Set xRg = Range("Information!C3")
xI = Int(xRg.Value)
If xI < 5 Then
Call Mail_small_Text_Outlook
End If
End Sub

Module1
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 = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
Range("Information!C3") & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Hi Jake,

According to your needs, please find ThisWorkbook in the Microsoft Visual Basic Applications window.
  567959C0-D2E1-4819-85E7-FA20A3D06BE9.png


Double-click ThisWorkbook and copy the code below:

'Update by Extendoffice 2022/2/17
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

On Error Resume Next

Dim RgC3 As Range
Dim RgC4 As Range
Dim RgC5 As Range

Set RgC3 = Range("Information!C3")
Set RgC4 = Range("Information!C4")
Set RgC5 = Range("Information!C5")


If (IsNumeric(RgC3) And RgC3.Value < 5) And (IsNumeric(RgC4) And RgC4.Value < 6) And (IsNumeric(RgC5) And RgC5.Value < 3) Then
Call Mail_small_Text_Outlook

ElseIf IsNumeric(RgC3) And RgC3.Value < 5 Then
Call Mail_small_Text_Outlook

ElseIf IsNumeric(RgC4) And RgC4.Value < 6 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 = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
Range("Information!C3") & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing

End Sub


Please change the xMailBody part as you need.

Amanda
·
2 years ago
·
0 Likes
·
0 Votes
·
0 Comments
·
View Full Post