Help with Auto Email sent from VBA, from only one cell value B6

[hsolanki]

Hi there

can someone help me resolve me below code whereby currently it is sending an auto email every time value has changed on any cells.

i have sheet whereby 90% cells are conditional formulated and i want email to be send automatically from a ONLY one cell (B6) when every time cells meets its target of 16 again 64 and anything more than 120 its value from a formulated from different cells.

below is the code;

Option Explicit

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


On Error GoTo errHandler:

Sheet2.Unprotect Password:="Bhaji2020"

NotSentMsg = "Not Sent"
SentMsg = "Sent"

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

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

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_Outlook_With_Signature_Html_1
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
Sheet2.Protect Password:="Bhaji2020"
' MsgBox "Some Error occurred." _
' & vbLf & Err.Number _
' & vbLf & Err.Description

On Error GoTo 0
Exit Sub
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & _
"The error number is: " & Err.Number & vbCrLf & _
Err.Description & vbCrLf & "Please Contact Admin"

End Sub

 

[hsolanki]

Hi can kindly someone help me please i can attach sample book if requires one