mattmcclements
New Member
- Joined
- Apr 15, 2022
- Messages
- 36
- Office Version
- 2016
- Platform
- 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
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
This is what I'm working with, Thank you in advance
| Lates Tracker - Trial.xlsm | |||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| A | B | C | D | E | F | G | H | I | J | K | |||
| 1 | Employee Name | Date late | Offence Number | Mins Late | Manager | Email confirmation | Due Date | Confirmation | 20/04/2022 12:02 | ||||
| 2 | |||||||||||||
| 3 | |||||||||||||
| 4 | Person A | 04/04/2022 | 3 | 69 | Manager B | 11/04/2022 | 0 | ||||||
| 5 | |||||||||||||
| 6 | |||||||||||||
| 7 | |||||||||||||
| 8 | |||||||||||||
| 9 | |||||||||||||
| 10 | |||||||||||||
| 11 | |||||||||||||
| 12 | |||||||||||||
| 13 | Person A | 04/04/2022 | 4 | 69 | Manager B | 11/04/2022 | 1 | ||||||
| 14 | |||||||||||||
| 15 | |||||||||||||
| 16 | |||||||||||||
| 17 | |||||||||||||
| 18 | |||||||||||||
| 19 | |||||||||||||
| 20 | |||||||||||||
| 21 | |||||||||||||
| 22 | Person A | 04/04/2022 | 5 | 69 | Manager B | 11/04/2022 | 1 | ||||||
| 23 | Person B | 05/04/2022 | 3 | 129 | Manager A | 12/04/2022 | |||||||
| 24 | Person C | 06/04/2022 | 3 | 189 | Manager A | 13/04/2022 | |||||||
| 25 | Person D | 07/04/2022 | 3 | 249 | Manager A | 14/04/2022 | |||||||
| 26 | Person E | 08/04/2022 | 3 | 309 | Manager A | 15/04/2022 | |||||||
| 27 | Person F | 09/04/2022 | 3 | 369 | Manager A | 16/04/2022 | |||||||
| 28 | Person G | 10/04/2022 | 3 | 429 | Manager A | 17/04/2022 | |||||||
| 29 | Person H | 11/04/2022 | 3 | 489 | Manager A | 18/04/2022 | |||||||
| 30 | Person I | 12/04/2022 | 3 | 549 | Manager A | 19/04/2022 | |||||||
| 31 | Person A | 04/04/2022 | 6 | 69 | Manager B | 11/04/2022 | |||||||
| 32 | Person B | 05/04/2022 | 4 | 129 | Manager A | 12/04/2022 | |||||||
| 33 | Person C | 06/04/2022 | 4 | 189 | Manager A | 13/04/2022 | |||||||
| 34 | Person D | 07/04/2022 | 4 | 249 | Manager A | 14/04/2022 | |||||||
| 35 | Person E | 08/04/2022 | 4 | 309 | Manager A | 15/04/2022 | |||||||
Confirmation | |||||||||||||
| Cell Formulas | ||
|---|---|---|
| Range | Formula | |
| K1 | K1 | =NOW() |
| A2:A35 | A2 | =IFERROR(IF(Lates!L2=Confirmation!$Z$1,Lates!A2,""),"") |
| B2:B35 | B2 | =IFERROR(IF(Lates!L2=Confirmation!$Z$1,Lates!C2,""),"") |
| C2:C35 | C2 | =IFERROR(IF(Lates!L2=Confirmation!$Z$1,Lates!K2,""),"") |
| D2:D35 | D2 | =IFERROR(VLOOKUP(A2,Lates!$A$2:$V$2412,22,FALSE),"") |
| E2:E35 | E2 | =IFERROR(VLOOKUP(A2,Lates!$A$2:$L$20000,10,FALSE),"") |
| G2:G35 | G2 | =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:
