IF AND variables VBA

mattmcclements

New Member
Joined
Apr 15, 2022
Messages
36
Office Version
  1. 2016
Platform
  1. Windows
Hi, I have the following spreadsheet which I need help coding. The idea is when "I" = 1 an email will be sent out automatically which says they have completed the task - this is all working. However, I would also like to add that when I = blank AND K1 ="G" to send out an email saying they have NOT completed task. Each email will be sent to the same email address with the same details.

This is what I'm working with, Thank you in advance

Cell Formulas
RangeFormula
K1K1=NOW()
A2:A35A2=IFERROR(IF(Lates!L2=Confirmation!$Z$1,Lates!A2,""),"")
B2:B35B2=IFERROR(IF(Lates!L2=Confirmation!$Z$1,Lates!C2,""),"")
C2:C35C2=IFERROR(IF(Lates!L2=Confirmation!$Z$1,Lates!K2,""),"")
D2:D35D2=IFERROR(VLOOKUP(A2,Lates!$A$2:$V$2412,22,FALSE),"")
E2:E35E2=IFERROR(VLOOKUP(A2,Lates!$A$2:$L$20000,10,FALSE),"")
G2:G35G2=IFERROR(B2+7,"")


Private Sub Worksheet_Change(ByVal Target As Range)

Dim MailAddress As String
Dim MailAddress_CC As String
Dim ByEmp As String
Dim OnDate As String
Dim MinLate As String
Dim NumOffs As String
Dim PerRes As String
On Error Resume Next

If Intersect(Range("I2:I1000"), Target) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

If IsNumeric(Target.Value) Then

If Target.Value = 1 Then

MailAddress = Range("X" & Target.Row).Value
MailAddress_CC = Range("Y" & Target.Row).Value

ByEmp = (Cells(Target.Row, "A"))

OnDate = (Cells(Target.Row, "B"))

MinLate = (Cells(Target.Row, "D"))

NumOffs = (Cells(Target.Row, "C"))

PerRes = (Cells(Target.Row, "E"))

Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByEmp, OnDate, MinLate, NumOffs, PerRes)

' Send the email
emailItem.Send


End If

End If

End Sub
Sub Mail_small_Text_Outlook(MailAddress As String, MailAddress_CC As String, ByEmp As String, OnDate As String, MinLate As String, NumOffs As String, PerRes As String)
Dim xOutApp As Object
Dim xOutMail As Object
Dim cell As Range
Dim strbody As String

Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

On Error Resume Next
With xOutMail
.To = MailAddress
.Cc = MailAddress_CC
.BCC = ""
.Subject = "Lates Investigation"
.htmlBody = "Hi, " & PerRes & " has completed their lates investigation on " & ByEmp & " who was late on " & OnDate & " by " & MinLate & " minutes, this was their " & NumOffs & " offence."
.Display
End With

On Error GoTo 0

Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub Check_Offences1()

Dim MailAddress As String
Dim MailAddress_CC As String
Dim ByEmp As String
Dim OnDate As String
Dim MinLate As String
Dim NumOffs As String
Dim PerRes As String
Dim Lr As Long
Dim r As Long
On Error Resume Next


With Sheets("Lates")

'Determine last row based on data in A
Lr = .Range("A" & .Rows.Count).End(xlUp).Row
'Loop through column K
For Each cell In .Range("I2:I" & Lr)


'test for offences >=3 AND 'email sent' not marked as 'Y' in column W (Offset 12 from K)
If IsNumeric(cell) And cell = 1 And Not cell.Offset(0, 12) = "Yes" Then
'update r as row of interest
r = cell.Row

'Establish parameters for email sub
' email addresses
MailAddress = .Range("X" & r).Value
MailAddress_CC = .Range("Y" & r).Value
'Employee
ByEmp = .Range("A" & r).Value
'Date
OnDate = CDate(.Range("B" & r))
'Minutes late
MinLate = .Range("D" & r)
'Number of offences
NumOffs = .Range("C" & r)

PerRes = .Range("E" & r)

'call email sub and pass variables
Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByEmp, OnDate, MinLate, NumOffs, PerRes)

'Send the email
emailItem.Send

'Mark email for row as sent, with 'Y' in column W
.Range("F" & r) = "Yes"

End If

Next

End With
End Sub
Private Sub Worksheet_Change1(ByVal Target As Range)

Dim MailAddress As String
Dim MailAddress_CC As String
Dim ByEmp As String
Dim OnDate As String
Dim MinLate As String
Dim NumOffs As String
Dim PerRes As String
On Error Resume Next

If Intersect(Range("I2:I1000"), Target) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

If IsNumeric(Target.Value) Then

If Target.Value = 0 Then

MailAddress = Range("X" & Target.Row).Value
MailAddress_CC = Range("Y" & Target.Row).Value

ByEmp = (Cells(Target.Row, "A"))

OnDate = (Cells(Target.Row, "B"))

MinLate = (Cells(Target.Row, "D"))

NumOffs = (Cells(Target.Row, "C"))

PerRes = (Cells(Target.Row, "E"))

Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByEmp, OnDate, MinLate, NumOffs, PerRes)

' Send the email
emailItem.Send


End If

End If

End Sub
Sub Mail_small_Text_Outlook1(MailAddress As String, MailAddress_CC As String, ByEmp As String, OnDate As String, MinLate As String, NumOffs As String, PerRes As String)
Dim xOutApp As Object
Dim xOutMail As Object
Dim cell As Range
Dim strbody As String

Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

On Error Resume Next
With xOutMail
.To = MailAddress
.Cc = MailAddress_CC
.BCC = ""
.Subject = "Lates Investigation"
.htmlBody = "Hi, " & PerRes & " has not completed their lates investigation on " & ByEmp & " who was late on " & OnDate & " by " & MinLate & " minutes, this was their " & NumOffs & " offence."
.Display
End With

On Error GoTo 0

Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub Check_Offences2()

Dim MailAddress As String
Dim MailAddress_CC As String
Dim ByEmp As String
Dim OnDate As String
Dim MinLate As String
Dim NumOffs As String
Dim PerRes As String
Dim Lr As Long
Dim r As Long
On Error Resume Next


With Sheets("Lates")

'Determine last row based on data in A
Lr = .Range("A" & .Rows.Count).End(xlUp).Row
'Loop through column K
For Each cell In .Range("I2:I" & Lr)


'test for offences >=3 AND 'email sent' not marked as 'Y' in column W (Offset 12 from K)
If IsNumeric(cell) And cell = 0 And Not cell.Offset(0, 12) = "Yes" Then
'update r as row of interest
r = cell.Row

'Establish parameters for email sub
' email addresses
MailAddress = .Range("X" & r).Value
MailAddress_CC = .Range("Y" & r).Value
'Employee
ByEmp = .Range("A" & r).Value
'Date
OnDate = CDate(.Range("B" & r))
'Minutes late
MinLate = .Range("D" & r)
'Number of offences
NumOffs = .Range("C" & r)

PerRes = .Range("E" & r)

'call email sub and pass variables
Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByEmp, OnDate, MinLate, NumOffs, PerRes)

'Send the email
emailItem.Send

'Mark email for row as sent, with 'Y' in column W
.Range("F" & r) = "Yes"

End If

Next

End With
End Sub
 
Last edited by a moderator:

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Hi, I have the following spreadsheet which I need help coding. The idea is when "I" = 1 an email will be sent out automatically which says they have completed the task - this is all working. However, I would also like to add that when I = blank AND K1 ="G" to send out an email saying they have NOT completed task. Each email will be sent to the same email address with the same details.

This is what I'm working with, Thank you in advance

Cell Formulas
RangeFormula
K1K1=NOW()
A2:A35A2=IFERROR(IF(Lates!L2=Confirmation!$Z$1,Lates!A2,""),"")
B2:B35B2=IFERROR(IF(Lates!L2=Confirmation!$Z$1,Lates!C2,""),"")
C2:C35C2=IFERROR(IF(Lates!L2=Confirmation!$Z$1,Lates!K2,""),"")
D2:D35D2=IFERROR(VLOOKUP(A2,Lates!$A$2:$V$2412,22,FALSE),"")
E2:E35E2=IFERROR(VLOOKUP(A2,Lates!$A$2:$L$20000,10,FALSE),"")
G2:G35G2=IFERROR(B2+7,"")


Private Sub Worksheet_Change(ByVal Target As Range)

Dim MailAddress As String
Dim MailAddress_CC As String
Dim ByEmp As String
Dim OnDate As String
Dim MinLate As String
Dim NumOffs As String
Dim PerRes As String
On Error Resume Next

If Intersect(Range("I2:I1000"), Target) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

If IsNumeric(Target.Value) Then

If Target.Value = 1 Then

MailAddress = Range("X" & Target.Row).Value
MailAddress_CC = Range("Y" & Target.Row).Value

ByEmp = (Cells(Target.Row, "A"))

OnDate = (Cells(Target.Row, "B"))

MinLate = (Cells(Target.Row, "D"))

NumOffs = (Cells(Target.Row, "C"))

PerRes = (Cells(Target.Row, "E"))

Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByEmp, OnDate, MinLate, NumOffs, PerRes)

' Send the email
emailItem.Send


End If

End If

End Sub
Sub Mail_small_Text_Outlook(MailAddress As String, MailAddress_CC As String, ByEmp As String, OnDate As String, MinLate As String, NumOffs As String, PerRes As String)
Dim xOutApp As Object
Dim xOutMail As Object
Dim cell As Range
Dim strbody As String

Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

On Error Resume Next
With xOutMail
.To = MailAddress
.Cc = MailAddress_CC
.BCC = ""
.Subject = "Lates Investigation"
.htmlBody = "Hi, " & PerRes & " has completed their lates investigation on " & ByEmp & " who was late on " & OnDate & " by " & MinLate & " minutes, this was their " & NumOffs & " offence."
.Display
End With

On Error GoTo 0

Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub Check_Offences1()

Dim MailAddress As String
Dim MailAddress_CC As String
Dim ByEmp As String
Dim OnDate As String
Dim MinLate As String
Dim NumOffs As String
Dim PerRes As String
Dim Lr As Long
Dim r As Long
On Error Resume Next


With Sheets("Lates")

'Determine last row based on data in A
Lr = .Range("A" & .Rows.Count).End(xlUp).Row
'Loop through column K
For Each cell In .Range("I2:I" & Lr)


'test for offences >=3 AND 'email sent' not marked as 'Y' in column W (Offset 12 from K)
If IsNumeric(cell) And cell = 1 And Not cell.Offset(0, 12) = "Yes" Then
'update r as row of interest
r = cell.Row

'Establish parameters for email sub
' email addresses
MailAddress = .Range("X" & r).Value
MailAddress_CC = .Range("Y" & r).Value
'Employee
ByEmp = .Range("A" & r).Value
'Date
OnDate = CDate(.Range("B" & r))
'Minutes late
MinLate = .Range("D" & r)
'Number of offences
NumOffs = .Range("C" & r)

PerRes = .Range("E" & r)

'call email sub and pass variables
Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByEmp, OnDate, MinLate, NumOffs, PerRes)

'Send the email
emailItem.Send

'Mark email for row as sent, with 'Y' in column W
.Range("F" & r) = "Yes"

End If

Next

End With
End Sub
Private Sub Worksheet_Change1(ByVal Target As Range)

Dim MailAddress As String
Dim MailAddress_CC As String
Dim ByEmp As String
Dim OnDate As String
Dim MinLate As String
Dim NumOffs As String
Dim PerRes As String
On Error Resume Next

If Intersect(Range("I2:I1000"), Target) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

If IsNumeric(Target.Value) Then

If Target.Value = 0 Then

MailAddress = Range("X" & Target.Row).Value
MailAddress_CC = Range("Y" & Target.Row).Value

ByEmp = (Cells(Target.Row, "A"))

OnDate = (Cells(Target.Row, "B"))

MinLate = (Cells(Target.Row, "D"))

NumOffs = (Cells(Target.Row, "C"))

PerRes = (Cells(Target.Row, "E"))

Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByEmp, OnDate, MinLate, NumOffs, PerRes)

' Send the email
emailItem.Send


End If

End If

End Sub
Sub Mail_small_Text_Outlook1(MailAddress As String, MailAddress_CC As String, ByEmp As String, OnDate As String, MinLate As String, NumOffs As String, PerRes As String)
Dim xOutApp As Object
Dim xOutMail As Object
Dim cell As Range
Dim strbody As String

Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

On Error Resume Next
With xOutMail
.To = MailAddress
.Cc = MailAddress_CC
.BCC = ""
.Subject = "Lates Investigation"
.htmlBody = "Hi, " & PerRes & " has not completed their lates investigation on " & ByEmp & " who was late on " & OnDate & " by " & MinLate & " minutes, this was their " & NumOffs & " offence."
.Display
End With

On Error GoTo 0

Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub Check_Offences2()

Dim MailAddress As String
Dim MailAddress_CC As String
Dim ByEmp As String
Dim OnDate As String
Dim MinLate As String
Dim NumOffs As String
Dim PerRes As String
Dim Lr As Long
Dim r As Long
On Error Resume Next


With Sheets("Lates")

'Determine last row based on data in A
Lr = .Range("A" & .Rows.Count).End(xlUp).Row
'Loop through column K
For Each cell In .Range("I2:I" & Lr)


'test for offences >=3 AND 'email sent' not marked as 'Y' in column W (Offset 12 from K)
If IsNumeric(cell) And cell = 0 And Not cell.Offset(0, 12) = "Yes" Then
'update r as row of interest
r = cell.Row

'Establish parameters for email sub
' email addresses
MailAddress = .Range("X" & r).Value
MailAddress_CC = .Range("Y" & r).Value
'Employee
ByEmp = .Range("A" & r).Value
'Date
OnDate = CDate(.Range("B" & r))
'Minutes late
MinLate = .Range("D" & r)
'Number of offences
NumOffs = .Range("C" & r)

PerRes = .Range("E" & r)

'call email sub and pass variables
Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByEmp, OnDate, MinLate, NumOffs, PerRes)

'Send the email
emailItem.Send

'Mark email for row as sent, with 'Y' in column W
.Range("F" & r) = "Yes"

End If

Next

End With
End Sub
Anyone able to help me out with this?
 
Upvote 0
Hi, quick update, I have made some changes to the original spreadsheet so that column "K" will now say if it is overdue or not. The code is exactly the same other than that change which I think makes things easier.

Thanks everyone
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

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