Send auto email based on two factors, date falls within 90days & cell value B6

H

hsolanki

Board Regular
Joined
Jan 16, 2020
Messages
204
Office Version
  1. 2010
Platform
  1. Windows
Good Morning all

i was wondering if anyone could help me. i have got a code that works fine based on the "B6" value however i now want to add an also if the value changes and it is within the 90 days (date value its in range E column.

below it is the code whereby i get an error run time error '13'

VBA Code: 
Dim SentMsg As String

Dim r As Range, cell As Range
Set r = Range("E3:E10000")

On Error GoTo errHandler:
Sheet3.Unprotect Password:="Bhaji2020"

NotSentMsg = "Not Sent"
SentMsg = "Sent"
    For Each cell In r
With Me.Range("B6")
    If Not IsNumeric(.Value) Then
        MyMsg = "Not numeric"
    Else

         If r.Value <= (Date - 90) And .Value > 15 And .Value < 30 Or .Value > 63 And .Value < 73 Or .Value > 124 Then
            MyMsg = SentMsg
            If .Offset(0, 1).Value = NotSentMsg Then
                Call Mail_Outlook_With_Signature_Html_1
                MsgBox "Email has been sent", vbInformation
            End If
        Else
            MyMsg = NotSentMsg
        End If
    End If
    Application.EnableEvents = False
    .Offset(0, 1).Value = MyMsg
    Application.EnableEvents = True
End With

Application.EnableEvents = True
Sheet3.Protect Password:="Bhaji2020", DrawingObjects:=False, Contents:=True, Scenarios:= _
        True

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 Admini"
Next
End Sub
 
Sort by date Sort by votes
There were sheet references that didn't match your workbook. Try this.
VBA Code: 
Private Sub SendMessage()

Dim SentMsg As String

Dim r As Range, cell As Range
Set r = Range("E3:E10000")

On Error GoTo errHandler:
Sheet6.Unprotect Password:="Bhaji2020"

NotSentMsg = "Not Sent"
SentMsg = "Sent"

    If Not IsNumeric(Me.Range("J27").Value) Then
        MyMsg = "Not numeric"
    Else
testvalue = Me.Range("J27").Value
    For Each cell In r
         If cell.Value <= (Date - 90) And testvalue > 15 And testvalue < 30 Or testvalue > 63 And testvalue < 73 Or testvalue > 124 Then
            MyMsg = SentMsg
            If cell.Offset(0, 1).Value = NotSentMsg Then
                Call Mail_Outlook_With_Signature_Html_1
                MsgBox "Email has been sent", vbInformation
            End If
        Else
            MyMsg = NotSentMsg
        End If
   
    Application.EnableEvents = False
    cell.Offset(0, 1).Value = MyMsg
    Application.EnableEvents = True

Next
End If
Sheet6.Protect Password:="Bhaji2020", DrawingObjects:=False, Contents:=True, Scenarios:= _
        True
On Error GoTo 0
Application.EnableEvents = True

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

End Sub
 
Upvote 0

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Hi Candyman thanks I have tried changing it to the right worksheet however when for example cell number "J2" value hits more than 16 it doesn't do anything or changes anything. i even tried debugging however nothing happens.

i am really confused
 
Upvote 0
sorry, I fat fingered the cell reference. Change references of J27 to J2
 
Upvote 0
Hi Candy thanks yh sorry i have now changed i to the right cell number J2 and as soon as the value changes to above 16 it is sending so many emails after email rather than just one email. and it is adding Not sent on all columns F all the way down.

it only needs to look/change for not sent or Sent on cell only on cell number K2
 
Upvote 0
Okay, I've made another change to only send as many emails as there are rows. Try this:
VBA Code: 
Private Sub SendMessage()

Dim SentMsg As String
Dim lastrow As Long
lastrow = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

Dim r As Range, cell As Range
Set r = Range("E3:E" & lastrow)

On Error GoTo errHandler:
Sheet6.Unprotect Password:="Bhaji2020"

NotSentMsg = "Not Sent"
SentMsg = "Sent"

    If Not IsNumeric(Me.Range("J2").Value) Then
        MyMsg = "Not numeric"
    Else
testvalue = Me.Range("J2").Value
    For Each cell In r
         If cell.Value <= (Date - 90) And testvalue > 15 And testvalue < 30 Or testvalue > 63 And testvalue < 73 Or testvalue > 124 Then
            MyMsg = SentMsg
            If Sheet6.Range("K2").Value = NotSentMsg Then
                Call Mail_Outlook_With_Signature_Html_1
                MsgBox "Email has been sent", vbInformation
            End If
        Else
            MyMsg = NotSentMsg
        End If
   
    Application.EnableEvents = False
    cell.Offset(0, 1).Value = MyMsg
    Application.EnableEvents = True

Next
End If
Sheet6.Protect Password:="Bhaji2020", DrawingObjects:=False, Contents:=True, Scenarios:= _
        True
On Error GoTo 0
Application.EnableEvents = True

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

End Sub
 
Upvote 0
Hi now it is recording mgs not sent on all columns F almost halfway down however the date function does not work either.

i think i have made a mistake. i think what I am trying to achieve is that it should compare the First S entered on column C and match the date on Column E on the same row and if the date falls within 3 months, then should send an email. i think this is too complex
 
Upvote 0
I'm sure the reason the date is being ignored is due to the way you have structure your AND OR line. Give this a go:
VBA Code: 
Private Sub SendMessage()

Dim SentMsg As String
Dim lastrow As Long
lastrow = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

Dim r As Range, cell As Range
Set r = Range("E3:E" & lastrow)

On Error GoTo errHandler:
Sheet6.Unprotect Password:="Bhaji2020"

NotSentMsg = "Not Sent"
SentMsg = "Sent"

    If Not IsNumeric(Me.Range("J2").Value) Then
        MyMsg = "Not numeric"
    Else
testvalue = Me.Range("J2").Value
    For Each cell In r
         If cell.Value <= (Date - 90) Then
            If (testvalue > 15 And testvalue < 30) Or (testvalue > 63 And testvalue < 73) Or testvalue > 124 Then
            MyMsg = SentMsg
            If Sheet6.Range("K2").Value = NotSentMsg Then
           '     Call Mail_Outlook_With_Signature_Html_1
          '      MsgBox "Email has been sent", vbInformation
            End If
             End If
        Else
            MyMsg = NotSentMsg
        End If
       
    Application.EnableEvents = False
    cell.Offset(0, 1).Value = MyMsg
    Application.EnableEvents = True

Next
End If
Sheet6.Protect Password:="Bhaji2020", DrawingObjects:=False, Contents:=True, Scenarios:= _
        True
On Error GoTo 0
Application.EnableEvents = True

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

End Sub
 
Upvote 0
Hi Candy sorry it is still sending out so many emails and also the dates are being ignored too and stamping msg not sent on column F all the way down
 
Upvote 0
There must be something else going on with your sheet. Based on the one you provided, here's what it looks like for me. If J2 is within one of the ranges specified and if the date is older than 90 days then it will send an email and specify which emails were sent. I'm not sure what your intended purpose of K2 is.

1667580808938.png
 
Upvote 0
Morning Candyman sorry for the late response. i have copied your exact code however when J2 reached one of the specified values and if the date is older than 90days it is keeping send an email and i can't seem to figure it out how to stop.

i have attached my sample book again whereby when you put S on the 2022 tab it updates on the logsheet tab and as soon as it reaches set ranges it continues sending emails

docs.google.com

Staff Sample File V1.xlsm

2022 MSC,Staff Candy File O/T,BS Late,0,SAMPLE - NAME Sick,8,Not Sent,ERN Number:,11223454 Absnt,0,Date of joining,20/09/21 Holiday 2,0,2 Recovery = 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19 JANUARY FEBRUARY MARCH,S APRIL:235.20,S MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBE...
docs.google.com docs.google.com

i would appreciate for all your help and time :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
How to combine similar Private Sub Worksheets?
Replies
3
Views
421
Rita9091
R
C
  • Question Question
Create code that sends emails and creates a log
Replies
1
Views
286
cokeoverpepsi123
C
S
  • Question Question
Send Second Email When Value Reaches Another Threshold
2 3
Replies
26
Views
1K
smythcounty
S
S
  • Solved
Insert Cell Value Into Email
Replies
2
Views
810
smythcounty
S
M
  • Question Question
Creating and emailing Excel sheet with only visible data
Replies
0
Views
501
mecerrato
M

Forum statistics

Threads
1,223,908
Messages
6,175,306
Members
452,633
Latest member
DougMo

Share this page

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
Back
Top