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

 

[frank_AL]

Ko,

I'm not getting that error. What version of Excel are you running? I may try to modify the code to eliminate using the VLOOKUP function as a work around for you.

 

[Tet Htut Naing]

Dear Frank_AL,

I got error in both 2010 MS Office excel and 2016 excel. I will retry by reading the code thoroughly and looking for the places I need to change in my excel file. Shall I upload my working file, after removing confidential email addresses, so that you could see the whole picture of what I am trying to do: my English is not so good to explain in details?

Best Regards,
Ko Htut

 

[frank_AL]

Ko,

I modified the code to eliminate using the VLOOKUP Function. I suspect if you have a very large number of employees you will notice that this version would run slower than using the VLOOKUP Function.

I understand what you are asking about having the code run anytime a value in the BN column is changed. That is very straight forward for one sheet. However, since you have a sheet for each month I'm not sure how to make that happen. I will need to do some research to find a solution. I know we could place some code on each worksheet but I'm thinking/hopeful there is a single solution that will provide a workable solution.

In the interim, you can assign a Keystroke shortcut to the Macro I've developed for you. Instructions for doing this is provided below:

According to Microsoft's documentation

1. On the Tools menu, point to Macro, and then click Macros.
2. In the Macro name box, enter the name of the macro you want to assign to a keyboard shortcut key.
3. Click Options.
4. If you want to run the macro by pressing a keyboard shortcut key, enter a letter in the Shortcut key box. You can use CTRL+ letter (for lowercase letters) or CTRL+SHIFT+ letter (for uppercase letters), where letter is any letter key on the keyboard. The shortcut key cannot use a number or special character, such as @ or #.
   Note: The shortcut key will override any equivalent default Microsoft Excel shortcut keys while the workbook that contains the macro is open.
   
5. If you want to include a description of the macro, type it in the Description box.
   
6. Click OK.
7. Click Cancel.

Option Explicit


Sub SendEmail()
Dim currmonth 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


usersel = InputBox("Enter Month to be Evaluated")
Set currmonth = Worksheets(usersel)
Set email = Worksheets("Email Addr")
emlastrow = email.Cells(email.Rows.Count, "A").End(xlUp).Row


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


For i = 4 To lastrow
    currval = ""
    If currmonth.Range("BN" & i).Value >= 5 Then
    staff = currmonth.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 currmonth.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 will be on vacation Monday through Thursday so I won't be able to do anything further until Thursday.

 

[Tet Htut Naing]

Dear Frank_AL,

I will test right away. Thanks for your very kind attention and helps.

Have a nice vacation !!!

Best Regards,
Ko Htut

 

[Tet Htut Naing]

Dear Frank_AL,

The second code is working fine. It displays outlook mail with correct email addresses. But it does not contain email body. But that's ok, I will try to accommodate it.

I really appreciate and thank for all of your kind attention and helps.

Best Regards,
Ko Htut

 

[frank_AL]

Ko, the code is pull the text for the email body from Worksheet "Email Addr".
If the value in column BN =5 it pulls from E4: emailbody = email.Range("E4").Value
If >5 it pulls from E5: emailbody = email.Range("E5").Value

You can place the following code module against each of your attendance worksheets. Instructions for doing this are provided below the code. I will resend the updated main code module in a separate reply.

Option Explicit
Public currmonth As Worksheet
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("BN:BN")) Is Nothing Then
    Set currmonth = ActiveWorkbook.ActiveSheet
    Call SendEmail(currmonth)
End If


End Sub

HOW TO INSTALL Event Code
------------------------------------
If you are new to event code procedures, they are easy to install. To install it, right-click the name tab at the bottom of the worksheet
that is to have the functionality to be provided by the event code and select "View Code" from the popup menu that appears.
This will open up the code window for that worksheet. Copy/Paste the event code into that code window.
That's it... the code will now operate automatically when its particular event procedure is raised by an action you take on the
worksheet itself. Note... if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm)
and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel)
the next time you open your workbook.

 

[frank_AL]

Update main code module that works with the worksheet code.

Option Explicit


Sub SendEmail(currmonth 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


'usersel = InputBox("Enter Month to be Evaluated")
Set email = Worksheets("Email Addr")
emlastrow = email.Cells(email.Rows.Count, "A").End(xlUp).Row


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


For i = 4 To lastrow
    currval = ""
    If currmonth.Range("BN" & i).Value >= 5 Then
    staff = currmonth.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 currmonth.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

 

[Tet Htut Naing]

Dear Frank_AL,

Main code module is working beautifully after setting currmonth as Active worksheet as

Set currmonth = ActiveWorkbook.ActiveSheet

Again, I replace the Sub line with

Sub SendEmail ()
Dim currmonth As Worksheet

However, the code for monthly worksheets in your previous reply does not run smoothly: it shows error at

Private Sub Worksheet_Change(ByVal Target As Range)

with yellow color and

Call SendEmail(currmonth)

with dark blue color. I don't want to take your precious time again for it because I am really afraid.

I am happy with the current status of one code working for me and I can run it manually.

I am really afraid of taking your precious time so long and I deeply thank for your paying attention and very kind helps.

Plus I learn a lot from you.

Best Regards,
Ko Htut

 

[frank_AL]

Ko, you are welcome. I like a good challenge so I don’t mind the back and forth. I can teenage when I get back Thursday.

 

[frank_AL]

Ko,

Let me know what is or isn't working and I can try to get it corrected for you.