If column cells certain values, read name and vlookup in another sheet for email

[Tet Htut Naing]

Dear All,

I am troubling with excel macro again.

There is staff attendance workbook in which 12 monthly sheets (one sheet represent one month) take records of all staff attendance time. If they are late on a date, then "pl" is put in that date of column. At the end of the columns, BN Column sums up the total frequency/time of late of staff.

What I want to do is
1) If a staff is late 5 times within a month or the value is 5 at one cell of Column BN, then read the value of the staff name in column C. Then, in Email Addr sheet within the same workbook, I want to do Vlookup to find the staff email address and his/her supervisor email address, adjacent cell to the staff email address.

2) Then I want to email to those email addresses.

What I find difficult for me is "reading the staff name" and VLookup for sending those email addresses in MS Outlook app.

Please help me.
Best Regards,
Ko Htut

 

[Tet Htut Naing]

Dear Frank_AL,

Hope you had very nice vacation. Thank you for remembering me.

Now I am troubling in joining two macros: the one you built in this thread and the other one created by someone in this forum.

At first, I imagined I could join those macros easily, but in real situation, I don't have enough knowledge to do so although learning about my case in many other threads.
As you know, I have 12 monthly sheets in each of which dates are written in row 3 starting from Column E, but saying pair of 2 columns for one date is more correct. For example, Row 3 Column D is blank and Row 3 Column E is for date. Then, Column BN stands for summing up of total frequencies of being late by staff. That's why I mentioned in previous posts that if column BN is 5 times or 6 times, then send email to the relevant staff and his/her supervisors. However, it is not that simple. I just want to send email only to the staffs who are late "today" and reach 5 or 6 times by today. Otherwise, it would count the staffs, to send eamil, who has been late for 5 or 6 times in previous days.
To handle this conditions, I have macros
1) Today macro to show only pair of columns in second column of which today date exists and hide the rest irrelevant pair of columns between Column C and Column BM. So, it is much easy for me to key in late status of the staffs and BN column will count and add up for today.
2) Filtering macro to apply filter on the today date existing column, 2nd column of column pair, in order to filter out blank cells. So, it leaves staffs who are late today in a visible range, Staff Names in Column C, late status in column pair and total late times of the staff in Column BN.
3) Emailing macro, that you have created in this thread, to find the values in column BN, if the value is 5 or 6 times by today, then read the relevant staff names and vlookup in Email Addr sheet to extract email addresses and send email to them.

For these things, I run Today macro separately and it is fine. Filtering macro is working fine too. Where I am in trouble is joing the filtering macro and emailing macro as follow

Sub FindLateTimes()

Application.ScreenUpdating = False

Dim rng         As Excel.Range
Dim tdlatelist  As Excel.Range
Dim tdlatelist1 As String
Dim TL          As Long
Dim LC          As Long
Dim LR          As Long
Dim x           As Long
Dim sh As Worksheet
Set sh = ActiveSheet

Dim email As Worksheet
Dim i As Long
Dim y As Long
Dim lastrow As Long
Dim emlastrow As Long
Dim currval As String
Dim OutLookApp As Object
Set OutLookApp = CreateObject("OutLook.Application")
Dim MItem As Object
Dim staff As String
Dim staffem As String
Dim svrem As String
Dim emailbody As String
Const olMailItem = 0
Dim lookuptable As Range

With sh
        If .AutoFilterMode Then .AutoFilterMode = False
        
        LC = .Cells(3, .Columns.Count).End(xlToLeft).Column
        
        Set rng = .Range("A3:BQ3").Resize(1, LC).Find(What:=Date, LookIn:=xlValues)
        
        If Not rng Is Nothing Then
            x = rng.Column
            LR = .Cells(.Rows.Count, rng.Column).End(xlUp).Row
            Set rng = .Range("A3:BQ3", rng).Resize(LR)
        Else
            MsgBox "Date not found, macro stopping", vbOKOnly
            End
        End If
        
        With rng
            .AutoFilter
            .AutoFilter field:=x, Criteria1:="<>"
            .Range("$C$3:$BQ$90").SpecialCells (xlCellTypeVisible)


Set email = Worksheets("Email Addr")
emlastrow = email.Cells(email.Rows.Count, "A").End(xlUp).Row


lastrow = sh.Cells(sh.Rows.Count, "C").End(xlUp).Row


For i = 4 To lastrow
    currval = ""
    If sh.Range("BN" & i).Value >= 5 Then
    staff = sh.Range("C" & i)
        For y = 4 To emlastrow
            currval = email.Range("A" & y).Value
            If currval = staff Then
                staffem = email.Range("B" & y).Value
                svrem = email.Range("C" & y).Value
                GoTo skip
            End If
        Next y
skip:
        If sh.Range("BN" & i).Value = 5 Then
            emailbody = email.Range("E4").Value
        Else
            emailbody = email.Range("E5").Value
        End If
        Set MItem = OutLookApp.CreateItem(olMailItem)
    '    On Error GoTo EmailFailed
        With MItem
            .BodyFormat = 3
            .To = staffem & ", " & svrem
            .Subject = "Failure to Comply with Attendance Policy"
            .HTMLBody = emailbody
            .Display
        End With
    End If
'EmailFailed:
Next i


End Sub

I am really sorry and afraid to annoy you again. I don't know if I should start a new thread for this problem.

In the above code, my problem is that I don't know how to set a new range for the visible range after being filtered and how to pick up BN column within the visible range to find the values (5 and 6). I am working in these days for it with several ways of results by searching online. But fail and fail.

If it is still relevant in this thread, please help me.

I am sorry to bother you again and again.

Best Regards,
Ko Htut

 

[frank_AL]

Ko,

I'm trying to create a solution but had no idea it was so difficult to filter date values to those equal to today's date. Still trying because I want to know how to solve this for my own knowledge.

I have created a new Forum Thread titled: https://www.mrexcel.com/forum/excel-questions/1040990-autofilter-todays-date.html

 

[Tet Htut Naing]

Dear Frank_AL,

It could be a bit misunderstanding because of my English. I am sorry for my bad English.

Things I am trying to achieve is not to filter the date values nor those equal to today's date. Because filtering on "Finding today date and filtering on that today date column is already successful. In the previous long post from me, there was one code in which the first part of the code do filtering works. Please take a look at below link, I upload my working file in which all things contain.
For a daily routine with the file is as follow
1) I will click on Today button, (if it is January, then please select "Jan'18_La_Rec" sheet, .. and click on Today button.) (I have the code for it and it is working.)
2) I will fill the data "pl" (for Personal Late), "odl" (on duty late), etc.. The column BN will count on personal late and BO will do on on duty late.
3) I will click on "Daily Report" button. It will direct me to another sheet, namely "Report". This particular code include filtering cells that contains any written things on that today date column. (I have the code and it is working.)

What I am trying to do is, before clicking on Daily Report button, I want to email to the staff who are late today up to 5 times or 6 times of personal late. The BN column shows all the counted personal lates of all staff. By filtering cells on today date column, the staff who are not late today will not be filtered and thus emails will not be sent to them, even if they were late in previous days up to 5/6 times.

Code for filtering cells on today date column is part of "Daily Report" macro. I take that code and want to join the code you created for sending email. For this, please check in "Findtodaylate" macro, Module 3 (button 19 on an'18_La_Rec Sheet), in the excel file of link attached. If this kind of link is not permittable in this forum, I am sorry and please guide me on this, I will follow.

I really appreciate and thank you very much for your kind attention and helps. (I delete all confidentialities in the file as much as possible.)
Best Regards,
Ko Htut


https://1drv.ms/x/s!Aidnd-lQ71-2hAYrbj4LJZpdjf78

 

[Tet Htut Naing]

Dear Frank_AL,

I come with some good news this time.

I changed the work flow of commanding this task to accomplish. In the attached excel file of previous post, you will find "Report" Sheet, after running "Daily Report" macro in monthly sheets. I run the code, you created, with some edits in "Report" Sheet and it works perfectly as I wish. The code is as follow;

Option Explicit


Sub SendEmailL()
Dim sh As Worksheet
Dim email As Worksheet
Dim usersel As String
Dim i As Long
Dim y As Long
Dim lastrow As Long
Dim emlastrow As Long
Dim currval As String
Dim OutLookApp As Object
Set OutLookApp = CreateObject("OutLook.Application")
Dim MItem As Object
Dim staff As String
Dim staffem As String
Dim svrem As String
Dim emailbody As String
Const olMailItem = 0
Dim lookuptable As Range


Set sh = ActiveWorkbook.ActiveSheet
Set email = Worksheets("Email Addr")
emlastrow = email.Cells(email.Rows.Count, "A").End(xlUp).Row


lastrow = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row


For i = 7 To lastrow
    currval = ""
    If sh.Range("E" & i).Value >= 5 Then
    staff = sh.Range("B" & i)
        For y = 2 To emlastrow
            currval = email.Range("A" & y).Value
            If currval = staff Then
                staffem = email.Range("B" & y).Value
                svrem = email.Range("C" & y).Value
                GoTo skip
            End If
        Next y
skip:
        If sh.Range("E" & i).Value = 5 Then
            emailbody = email.Range("E4").Value
            
        Else
         If sh.Range("E" & i).Value = 6 Then
            emailbody = email.Range("E5").Value
            End If
        End If
        Set MItem = OutLookApp.CreateItem(olMailItem)
    '    On Error GoTo EmailFailed
        With MItem
            .BodyFormat = 3
            .To = staffem & ", " & svrem
            .Subject = "Failure to Comply with Attendance Policy"
            .HTMLBody = emailbody
            .Display
        End With
    End If
'EmailFailed:
Next i

End Sub

I deeply thank you for the code.

Now I am working forward to put the staff names in Email, I have no idea so far though.

Anyway, it is really good to learn many things from you and I really thank you for your kind helps.

Best Regards,
Ko Htut

 

[Tet Htut Naing]

Dear Frank_AL,

My work for this post has now accomplished successfully with the code below:

Option Explicit


Sub SendEmailL()
Dim sh As Worksheet
Dim email As Worksheet
Dim usersel As String
Dim i As Long
Dim y As Long
Dim lastrow As Long
Dim emlastrow As Long
Dim currval As String
Dim OutLookApp As Object
Set OutLookApp = CreateObject("OutLook.Application")
Dim MItem As Object
Dim staff As String
Dim staffem As String
Dim svrem As String
Dim emailbody As String
Const olMailItem = 0


Set sh = ActiveWorkbook.ActiveSheet
Set email = Worksheets("Email Addr")
emlastrow = email.Cells(email.Rows.Count, "A").End(xlUp).Row


lastrow = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row


For i = 7 To lastrow
    currval = ""
    If sh.Range("E" & i).Value >= 5 Then
    staff = sh.Range("B" & i)
        For y = 2 To emlastrow
            currval = email.Range("A" & y).Value
            If currval = staff Then
                staffem = email.Range("B" & y).Value
                svrem = email.Range("C" & y).Value
                GoTo skip
            End If
        Next y
skip:
        If sh.Range("E" & i).Value = 5 Then
            emailbody = "Dear " & staff & "," & vbCrLf & _
                         email.Range("E4").Value
            
        Else
         If sh.Range("E" & i).Value = 6 Then
            emailbody = "Dear " & staff & "," & vbCrLf & email.Range("E5").Value
            End If
        End If
        Set MItem = OutLookApp.CreateItem(olMailItem)
    '    On Error GoTo EmailFailed
        With MItem
            .To = staffem & ", " & svrem
            .Subject = "Notice of Being Late Status"
            .Body = emailbody
            .BodyFormat = 1
            .Display
        End With
    End If
'EmailFailed:
Next i

End Sub

It works very perfectly as I wish.
Thank you very much for all of your kind helps and assists.

Best Regards,
Ko Htut

 

[frank_AL]

Ko,

I'm glad I could help you and that you have been able to achieve a solution that works for you.

Best wishes to you.

Frank