Sending Specific emails if a specific cell changes

JON_ROCKS

New Member
Joined
Jan 18, 2021
Messages
17
Office Version
  1. 2019
Hi All, I am fairly new to Excel, I need to make the below work , it does trigger email but only for cell M6 then nothing? Can anybody help?

HTML:
Option Explicit

Private Sub Worksheet_Calculate()
 If Me.Range("M6").Value < 3 Then
        Call Mail_small_Text_Outlook
    End If
End Sub

Sub Worksheet_Calculate7()
 If Me.Range("M7").Value < 3 Then
        Call Mail_small_Text_Outlook7
    End If
End Sub

Private Sub Worksheet_Calculate_8()
 If Me.Range("M8").Value < 3 Then
        Call Mail_small_Text_Outlook_8
    End If
End Sub
Private Sub Worksheet_Calculate_9()
 If Me.Range("M9").Value < 3 Then
        Call Mail_small_Text_Outlook_9
    End If
End Sub

HTML:
Option Explicit

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 Laura" & vbNewLine & vbNewLine & _
              "The current stock of Accusence Cameras Part Number: DS-2CD2346G2-I is at 3 units or below. New stock should be ordered." & vbNewLine & _
              "Kind Regards" & vbNewLine & vbNewLine & _
              "Stock Keeper"
    On Error Resume Next
    With xOutMail
        .To = "jon@test.co.uk"
        .CC = ""
        .BCC = ""
        .Subject = "Low Stock Alert - Acusense Cameras"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub


Sub Mail_small_Text_Outlook_7()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi Laura" & vbNewLine & vbNewLine & _
              "The current stock of POE Hubs is at 3 units or below. New stock should be ordered." & vbNewLine & _
              "Kind Regards" & vbNewLine & vbNewLine & _
              "Stock Keeper"
    On Error Resume Next
    With xOutMail
        .To = "jon@test.co.uk"
        .CC = ""
        .BCC = ""
        .Subject = "Low Stock Alert - POE HUB"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Sub Mail_small_Text_Outlook_8()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi Laura" & vbNewLine & vbNewLine & _
              "The current stock of Stock 99 is at 3 units or below. New stock should be ordered." & vbNewLine & _
              "Kind Regards" & vbNewLine & vbNewLine & _
              "Stock Keeper"
    On Error Resume Next
    With xOutMail
        .To = "jon@test.co.uk"
        .CC = ""
        .BCC = ""
        .Subject = "Low Stock Alert - Stock99"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Sub Mail_small_Text_Outlook_9()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi Laura" & vbNewLine & vbNewLine & _
              "The current stock of STOCK 100 is at 3 units or below. New stock should be ordered." & vbNewLine & _
              "Kind Regards" & vbNewLine & vbNewLine & _
              "Stock Keeper"
    On Error Resume Next
    With xOutMail
        .To = "jon@test.co.uk"
        .CC = ""
        .BCC = ""
        .Subject = "Low Stock Alert - STOCK 100"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

HTML:
 

JON_ROCKS

New Member
Joined
Jan 18, 2021
Messages
17
Office Version
  1. 2019
so upon further investigation the multiple email windows that open are caused by the unused cells which are counted as 0 for some reason , for example notice i go to i jump from
VBA Code:
    sName(33) = "Stock 100"

    sName(37) = "Stock 100"
So 34 through 36 still register as 0 and are counted for some reason?

any idea how i rectify this?

i really appreciate you helping me with this.
 

Some videos you may like

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

StephenCrump

MrExcel MVP
Joined
Sep 18, 2013
Messages
4,121
Office Version
  1. 365
Platform
  1. Windows
For the purposes of illustration, I hard-coded:

VBA Code:
    sName(6) = "Accusence Cameras Part Number: DS-2CD2346G2-I"
    sName(7) = "POE Hubs"
    sName(8) = "Stock 99"
    sName(9) = "Stock 100"

But it would be silly to do this for potentially hundreds of product names.

It looks like your quantities are currently in M6:M58. Is there a similar range that contains the corresponding product names? If so, we can simply point the code to that. And we can have the code test for blank lines so that it doesn't generate an email.

Another option you might like to consider. If there are 10 items needing re-order, would it make sense to send one email with a list of 10, rather than 10 separate e-mails?
 

JON_ROCKS

New Member
Joined
Jan 18, 2021
Messages
17
Office Version
  1. 2019
Yes both great options how do i go about it?

Would be super useful if every unit that went <3 were added into one email, This can be done?!
 

StephenCrump

MrExcel MVP
Joined
Sep 18, 2013
Messages
4,121
Office Version
  1. 365
Platform
  1. Windows
Perhaps something along these lines:

Stock ordering.xlsm
ABCD
1
2ItemQuantity
3A0
4B1
5C5
6D12
7E7
8F2
9G1
10H3
11I6
12J0
13K1
14L4
Sheet1

Code:
Sub CheckStock()
 
    Dim NoRows As Long, i As Long, counter As Long
    Dim Items As Variant, Quantity As Variant
    Dim s As String
    Const MIN_STOCK = 3
    Const START_ROW = 3
    
    With Worksheets("Sheet1")   'adjust as required
        NoRows = .Range("B" & Rows.Count).End(xlUp).Row - START_ROW + 1
        Items = .Range("B" & START_ROW).Resize(NoRows).Value
        Quantity = .Range("D" & START_ROW).Resize(NoRows).Value
    End With
    For i = 1 To NoRows
        If Quantity(i, 1) <= MIN_STOCK Then
            counter = counter + 1
            s = s & Items(i, 1) & vbNewLine
        End If
    Next i
    
    If counter > 0 Then
        Call Mail_small_Text_Outlook(s)
    Else
        MsgBox "All good!"
    End If
        
 End Sub
Sub Mail_small_Text_Outlook(s As String)
    
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi Laura" & vbNewLine & vbNewLine & _
        "The current stock of these items is at 3 units or below. New stock should be ordered." & vbNewLine & s & _
        vbNewLine & "Kind Regards" & vbNewLine & vbNewLine & _
        "Stock Keeper"
    With xOutMail
        .to = "jon@test.co.uk"
        .Subject = "Low Stock Alert"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    
    Set xOutMail = Nothing
    Set xOutApp = Nothing

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,935
Messages
5,627,708
Members
416,268
Latest member
zRGZgDNnmaPhepwviEou

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top