Send Email based on Event

hiker8117 · Apr 8, 2018

Hello,

Looking to send an email based upon an event that takes in Excel.

We are a manufacturing firm and allocate funds for training apprentices. We track labor hours and labor dollars expended weekly per Job order, date and apprentice. We pull down the file/records from our main server into Access and then query the results into Excel. The apprentice labor rate is obviously less than seasoned workers and we are trying to create an alert via email when this excel file recognizes a labor rate greater than the average labor rate of the apprentice. Our purpose is to alert and warn supervisors to stop erroneously charging this training Job order for labor expended that is not tied to training. It is either through laziness or errors that the supervisors charge labor hours incorrectly. I need to create a function or VBA that recognizes a greater labor rate than that of apprentices and create an email. The records also have the dates labor was posted and I need to have in the function or VBA a way to not create an email on older records that have a higher than average labor rate but new records that have a higher rate. Without that ability every time we update the file it would see a higher than average labor rate from older records and send emails all the time. Not sure if VBA could also isolate and pull these new records into a new worksheet that would be part of this email. The email and attachment would be directed to the Director of Production for resolution.

Any help would be appreciated.

Thank you

Gene Haines

Logit · Apr 8, 2018

.
Is the "greater labor rate than that of apprentices" located in one cell when the supervisor fills out the information ? If so, what cell ? Also, what amount is considered too much ?

hiker8117 · Apr 9, 2018

Logit said:
.
Is the "greater labor rate than that of apprentices" located in one cell when the supervisor fills out the information ? If so, what cell ? Also, what amount is considered too much ?

Yes. The record column headers are: JO, Last Name, First Name, Hours, Dollars, Rate, Date, Month, Quarter, Fiscal Year.

Rate falls under Column F

Apprentice rate is $27.50 per hour. Higher than could be $57.00 up to $75.00

Regards

Gene

Logit · Apr 10, 2018

.
Paste the following in to a Routine Module :

Code:

Sub SearchForString()


   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer


   On Error GoTo Err_Execute


   'Start search in row24
   LSearchRow = 2


   'Start copying data to row 2 in Temp Sheet(row counter variable)
   LCopyToRow = 2
Application.ScreenUpdating = False
    While Len(Range("A" & CStr(LSearchRow)).Value) > 0


      'If value in column F matches values, copy entire row to Temp Sheet
      If Range("F" & CStr(LSearchRow)).Value > 55 And Range("F" & CStr(LSearchRow)).Value < 75 And Range("K" & CStr(LSearchRow)).Value = "" Then


         'Select row in Sheet1 to copy
         Range("K" & CStr(LSearchRow)).Value = Now()
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy


         'Paste row into Temp Sheet in next row
         Sheets("Temp Sheet").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste
         Range("A1").Select
         
         'Paste row into Master File in next row
         Dim pasteSheet As Worksheet
         Set pasteSheet = Worksheets("Master File")
         pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
         pasteSheet.Activate
         pasteSheet.Range("A1").Select
                  
         'Move counter to next row
         LCopyToRow = LCopyToRow + 1


         'Go back to Sheet1 to continue searching
         Sheets("Sheet1").Select


      End If


      LSearchRow = LSearchRow + 1


   Wend


   'Position on cell A1
   Application.CutCopyMode = False
   Range("A1").Select
Application.ScreenUpdating = True
   'MsgBox "All matching data has been copied."
   mailTableWithGridLines
   Exit Sub


Err_Execute:
   MsgBox "An error occurred."


End Sub



Sub mailTable()
Dim OutApp As Object
Dim OutMail As Object
Dim vInspector, GetInspector, wEditor As Variant




Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .To = "DirectorofProduction@nowhere.com"
    .CC = "xyz@anc.com"
    .BCC = "abc@xyz.com"
    .Subject = "Apprentice Labor Rate Review"
    .Body = "Please review the following :  " & vbCrLf
    .Display
    Worksheets("Temp Sheet").Activate
    ActiveSheet.UsedRange.Copy
    Set vInspector = OutMail.GetInspector
    Set wEditor = vInspector.WordEditor


    wEditor.Application.Selection.Start = Len(.Body)
    wEditor.Application.Selection.End = wEditor.Application.Selection.Start


    wEditor.Application.Selection.Paste


.Display
End With
Application.CutCopyMode = False


With Sheets("Temp Sheet")
    Range([a2], Cells(Rows.Count, "A")).EntireRow.Delete
End With


'Go back to Sheet1
         Sheets("Sheet1").Select
          Range("A1").Select
End Sub

Download workbook here --- > https://www.amazon.com/clouddrive/share/uBz4DQE1D0FpG3NCbCpfhzPtuvdPHye1YNcr5h7LLlo

hiker8117 · Apr 11, 2018

Wow..what a time saver for me and a heart felt thank you for sharing your knowledge. I just picked up a used book "Programming with VBA and will attempt to teach myself. Will apply these VBA/Macros to the file I am using at work.

Again,....thank you so very much.

Gene Haines

Logit · Apr 11, 2018

.
You are welcome.

hiker8117 · Apr 11, 2018

One question if I may. The downloaded file contained 2 vba macros....Mailtable and Searchforstring. They worked fine, however should I have copied the code in your reply and pasted that into 2 new modules and used this code versus the 2 existing macros.

Thank you

Logit · Apr 11, 2018

.
Not necessary.

I always try to include a sample workbook with working code. Oftentimes, it helps the other person better understand.

hiker8117 · Apr 13, 2018

I ran a test in work and it worked perfectly, however I just realized that other people will be receiving this email and Temp Sheet that shows the Rate of the individual.

I should not be broadcasting individuals hourly rates so my question is?

Can the code be structured to just send the JO, Last Name, First Name, Hours and Date from the Temp Sheet. I can rearrange the columns so that they follow this order.

Apologize for not thinking of this up front.

Regards

Gene Haines

Logit · Apr 13, 2018

.
Made a change to this macro :

Code:

Option Explicit
Sub SearchForString()


   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer


   On Error GoTo Err_Execute


   'Start search in row24
   LSearchRow = 2


   'Start copying data to row 2 in Temp Sheet(row counter variable)
   LCopyToRow = 2
Application.ScreenUpdating = False
    While Len(Range("A" & CStr(LSearchRow)).Value) > 0


      'If value in column F matches values, copy entire row to Temp Sheet
      If Range("F" & CStr(LSearchRow)).Value > 55 And Range("F" & CStr(LSearchRow)).Value < 75 And Range("K" & CStr(LSearchRow)).Value = "" Then


         'Select row in Sheet1 to copy
         Range("K" & CStr(LSearchRow)).Value = Now()
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy


         'Paste row into Temp Sheet in next row
         Sheets("Temp Sheet").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste
         Range("A1").Select
         
         'Paste row into Master File in next row
         Dim pasteSheet As Worksheet
         Set pasteSheet = Worksheets("Master File")
         pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
         pasteSheet.Activate
         pasteSheet.Range("A1").Select
                  
         'Move counter to next row
         LCopyToRow = LCopyToRow + 1


         'Go back to Sheet1 to continue searching
         Sheets("Sheet1").Select


      End If


      LSearchRow = LSearchRow + 1


   Wend


Sheets("Temp Sheet").Select
Columns("F:K").EntireColumn.Delete


   'Position on cell A1
   Application.CutCopyMode = False
   Range("A1").Select
Application.ScreenUpdating = True
   'MsgBox "All matching data has been copied."
   mailTable
   Exit Sub


Err_Execute:
   MsgBox "An error occurred."


End Sub

Download updated workbook here --->> https://www.amazon.com/clouddrive/share/5oPMmQN1V3vMw61vV3cnzpYoDim064C5Jy315e0Sdgw

Send Email based on Event

hiker8117

New Member

Excel Facts

Logit

Well-known Member

hiker8117

New Member

Logit

Well-known Member

hiker8117

New Member

Logit

Well-known Member

hiker8117

New Member

Logit

Well-known Member

hiker8117

New Member

Logit

Well-known Member

Similar threads

Forum statistics

Share this page

Send Email based on Event

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock