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
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Sort by date Sort by votes
Hi Candyman8019, thanks. getting error on
VBA Code: 
 If r.Value <= (Date - 90) And .Value > 15 And .Value < 30 Or .Value > 63 And .Value < 73 Or .Value > 124 Then
 
Upvote 0
It looks like your column E range contains dates and B6 contains a number. I moved a few things around in your script, but I haven't actually tested it...but I think it should get you on the right track.
VBA Code: 
Private Sub cleansheet()
Dim lastrow As Long
Dim i As Long
Dim testvalue As Integer

lastrow = Cells(Rows.Count, 5).End(xlUp).Row + 1

For i = 7 To lastrow
    If Cells(i, 6) = "2" Then Cells.Rows(i).Delete
Next
End Sub
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"

With Me.Range("B6")
    If Not IsNumeric(.Value) Then
        MyMsg = "Not numeric"
    Else
testvalue = Me.Range("B6").Value
    For Each cell In r
         If r.Value <= (Date - 90) And testvalue.Value > 15 And testvalue.Value < 30 Or testvalue.Value > 63 And testvalue.Value < 73 Or testvalue.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
 
Upvote 0
Morning Candy

Many thanks for drafting a code for me however i still get an error on the same line. just to give you an idea of my workbook below is.

when on cell number "J2" changes the number between 15-30, 64-70 & 124 above, it will also need to look for msg sent or not sent in cell number "K2& and if the date is falls within the last 3 months from the last 3 months

1667551887656.png
 
Upvote 0
try changing:
VBA Code: 
If r.Value <= (Date - 90) And testvalue.Value > 15 And testvalue.Value < 30 Or testvalue.Value > 63 And testvalue.Value < 73 Or testvalue.Value > 124 Then
to
VBA Code: 
If r.Value <= (Date - 90) And testvalue > 15 And testvalue < 30 Or testvalue > 63 And testvalue < 73 Or testvalue > 124 Then
 
Upvote 0
Okay, I tried this out on my sheet and the following works.
VBA Code: 
Private Sub cleansheet()
Dim lastrow As Long
Dim i As Long
Dim testvalue As Integer

lastrow = Cells(Rows.Count, 5).End(xlUp).Row + 1

For i = 7 To lastrow
    If Cells(i, 6) = "2" Then Cells.Rows(i).Delete
Next

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"

    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
Sheet3.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, Thank you. sorry i Can't get it going with the new code and was wondering if you could help. basically, what i am trying to achieve is that on sheet 2 any information is typed is recorded on the logsheet tab and all the capital S is then calculated on the cell number "J2" and if the total is reached between 16-30, 64-70 & anything above 124 and if the last S entered falls within the past 3 months date which is in column E then it will ask to send an automated email. i have attached my sample book just to give you an overview for a better idea

docs.google.com

Staff Sample File.xlsm

2022 MSC,Staff Candy File O/T,BS Late,0,SAMPLE - NAME Sick,27,Not Sent,ERN Number:,11223454 Absnt,0,Date of joining,20/09/21 Holiday 3,0,3 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 MAY JUNE JULY AUGUST,S SEPTEMBER OCTOBER NOVEMBER DECEMB...
docs.google.com docs.google.com

i would really appricate if you would help me with my code
 
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