VBA Code to allow changes for each cell in 12 rows.

Hi,

I currently have the below code for an inventory tracking sheet to auto send me an email anytime the number for any given appliance reaches Zero.

My problem is that I had to list each appliance on different tabs instead of it allowing me to just list on each row because the code only works per worksheet and not individual cells.

It would be idea to keep it on one worksheet and just have the appliances listed on the 12 rows.

Hope this makes sense.


Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("c6"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value < 1 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 & _
"Attic stock alert for Range Hoods" & vbNewLine & _
""
On Error Resume Next
With xOutMail
.To = "joneill@onni.com"
.CC = ""
.BCC = ""
.Subject = "Range Hood Stock Alert"
.Body = xMailBody
.Send 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub