mattmcclements
New Member
- Joined
- Apr 15, 2022
- Messages
- 36
- Office Version
- 2016
- Platform
- Windows
Hi, in the column "K" an email will flag when =>3, however, I'm trying to change it so IF "L" = "Investigate" it will flag the email instead. This is what I'm currently working with, thank you for any help in advance.
| Cell Formulas | ||
|---|---|---|
| Range | Formula | |
| F2:F21 | F2 | =IF(Lates!I2=Master!$D$2,VLOOKUP(Lates!E2,Master!$K$2:$L$8,2,FALSE),VLOOKUP(B2,Master!$C$2:$I$1008,7,FALSE)) |
| G2:G21 | G2 | =IF(D2>F2,D2-F2,"NOT LATE") |
| I2:I21 | I2 | =INDEX(Master!$D$2:$D$1332,MATCH(B2,Master!$C$2:C1007,0)) |
| J2:J21 | J2 | =IF(I2=$O$2,"Joe Westwell",IF(I2=$O$3,"Aaron Johnson",IF(I2=$O$5,"Gareth Roberts",IF(I2=$O$6,"Steven Jones",IF(I2=$O$4,"Lee Massey",IF(I2=$O$7,"Malcolm Wright",IF(I2=$O$9,"Craig Jones",IF(I2=$O$8,"Lukasz Pawlik",IF(I2=$O$10,"Mike Moffatt",IF(I2=$O$11,"MANAGER",IF(I2=$O$12,"Gary Lee",IF(I2=$O$13,"Gary Lee",IF(I2=$O$14,"Mark Wright"))))))))))))) |
| K2:K21 | K2 | =COUNTIFS($B$2:B2,B2,$H$2:H2,"LATE") |
| L2:L21 | L2 | =IF(H2=$S$1,"NOT LATE",IF(K2>=3,"Investigate",IF(K2=2,"1 Away",IF(K2=1,"First one")))) |
| A2:A21 | A2 | =IFERROR(INDEX(Master!$F$2:$F$1332,MATCH(B2,Master!$C$2:C1007,0)),"NOT IN MASTER SHEET") |
| Cells with Conditional Formatting | ||||
|---|---|---|---|---|
| Cell | Condition | Cell Format | Stop If True | |
| C15:D17 | Cell Value | contains "LEAVER" | text | NO |
| C15:C17 | Cell Value | between 3 and 1000 | text | NO |
| C13:D14 | Cell Value | contains "LEAVER" | text | NO |
| C13:C14 | Cell Value | between 3 and 1000 | text | NO |
| F:F | Cell Value | contains "OVERTIME" | text | NO |
| G2:G3394 | Cell Value | contains "NOT LATE" | text | NO |
| A:A | Cell Value | contains "NOT IN MASTER SHEET" | text | NO |
| 3395:1048576,Q15:W18,O3:W14,O15:O18,C2:AA2,P19:W19,A2987:L3394,A2985:A2986,E2985:L2986,A273:L1130,M3:N1130,A1131:N1133,A1134:L2984,M1134:N3394,1:1,O20:W3394,X3:XFD3394,J3:K3394,E13:L17,C3:L12,A2:A272,AC2:XFD2,H3:H3394,C18:L272 | Cell Value | contains "LEAVER" | text | NO |
| G2:G3394 | Cell Value | >=0.000694444 | text | NO |
| K2:K3394 | Cell Value | =0 | text | NO |
| L2:L3394 | Cell Value | contains "NOT LATE" | text | NO |
| K2:K3394 | Cell Value | contains "NOT LATE" | text | NO |
| J2:J3394 | Cell Value | contains "MANAGER" | text | NO |
| I2:I3394 | Cell Value | contains "NA" | text | NO |
| L2:L3394 | Expression | =L2="First one" | text | NO |
| K2:K3394 | Cell Value | =1 | text | NO |
| L2:L3394 | Expression | =L2="1 Away" | text | NO |
| K2:K3394 | Cell Value | =2 | text | NO |
| L2:L3394 | Expression | =L2="Investigate" | text | NO |
VBA Code:
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 DueDate As String
On Error Resume Next
If Intersect(Range("L2:L10000"), Target) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If IsNumeric(Target.Value) Then
If TextBox1.Text = "Investigate" Then
MailAddress = Range("M" & Target.Row).Value
MailAddress_CC = Range("N" & Target.Row).Value
ByEmp = (Cells(Target.Row, "A"))
OnDate = (Cells(Target.Row, "C"))
MinLate = (Cells(Target.Row, "V"))
NumOffs = (Cells(Target.Row, "K"))
DueDate = (Cells(Target.Row, "X"))
Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByEmp, OnDate, MinLate, NumOffs, DueDate)
' 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, DueDate 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," & vbNewLine & vbNewLine & "you have a lates investigation to complete on " & ByEmp & " who was late on " & OnDate & " by " & MinLate & " minutes, this is their " & NumOffs & " offence. It is due on " & DueDate & " , please make sure you confirm that you have completed an investigation if necessary."
.Display
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub Check_Offences()
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 DueDate 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("L2:L" & Lr)
'test for offences >=3 AND 'email sent' not marked as 'Y' in column W (Offset 12 from K)
If UCase(cell) And cell = "Investigate" 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("M" & r).Value
MailAddress_CC = .Range("N" & r).Value
'Employee
ByEmp = .Range("A" & r).Value
'Date
OnDate = CDate(.Range("C" & r))
'Minutes late
MinLate = .Range("V" & r)
'Number of offences
NumOffs = .Range("K" & r)
DueDate = .Range("X" & r)
'call email sub and pass variables
Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByEmp, OnDate, MinLate, NumOffs, DueDate)
'Send the email
emailItem.Send
'Mark email for row as sent, with 'Y' in column W
.Range("W" & r) = "Yes"
End If
Next
End With
End Sub
