Automatic Email when Cell is Certain Value

Question

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

Hücre Belirli Değerde Olduğunda Otomatik E-posta