VBA code to send Emails for every finished Job

[paulo78]

Hello,

I have Job List in excel where the user can enter up to 300 Jobs each row one job (restriction for now). He can then enter the percentage of completion. When the Job is done he can click a drop down list to choose a department and next to it on a Hyperlink where he it will open the email client Outlook to send a ready email to that department with a fix email body and the reference Job in that cell.
Like this for example:

This is an automated email to inform you that we have finished the below mentioned Job:
Test Job 123
Thank you

All this works so far for one row. But now i have to copy the code for 299 rows + for each department so the code will be huge . Somehow i have made a thought mistake here. Any ideas how to improve my code.

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) 'Excel VBA

' Prepare Link JobEntry ROW 1

If Target.Range.Address = "$P$9" And Range("$O$9").Text = "Electric Dept.BH" Then
    Call Email_To_E_Depart
  ElseIf Target.Range.Address = "$P$9" And Range("$O$9").Text = "Mechanical Dept.BH" Then
    Call Email_To_E_Depart
  ElseIf Target.Range.Address = "$P$9" And Range("$O$9").Text = "Operators Dept.BH" Then
    Call Email_To_E_Depart
  ElseIf Target.Range.Address = "$P$9" And Range("$O$9").Text = "Team Dept.Packaging" Then
    Call Email_To_E_Depart
  ElseIf Target.Range.Address = "$P$9" And Range("$O$9").Text = "Operator Dept.Packaging" Then
    Call Email_To_E_Depart
End If

End Sub

' Send Email to E-Department JobEntry ROW 1

Sub Email_To_E_Depart()

Dim emailApplication As Object
Dim emailItem As Object

Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)

' Look Up Send To addresses
Set emailRng = Worksheets("Settings").Range("Q3:Q10")
' add ; between each address
    For Each cl In emailRng
        sTo = sTo & ";" & cl.Value
    Next

' Look Up CC addresses
Set CCRng = Worksheets("Settings").Range("Q3:Q10")
' add ; between each address
    For Each cl In CCRng
        sCC = sCC & ";" & cl.Value
    Next
    
' Now we build the email

emailItem.to = sTo

'emailItem.CC = sCC

emailItem.Subject = Worksheets("Settings").Range("Q13")

emailItem.HTMLBody = "Dear All," & "<br><br>" & "This is an automated email to inform you that we have finished the below mentioned Job:" _
& "<br><br><b>" & Range("D9").Value & "</b><br><br>" _
& "Thank you,<br><br>" _
& "Electrical and Automations Department<br>" _
& "<i>Job Manager-V12 Auto Reporting Service</i><br>" _

' Display the Email so the user can cehck it before sending it
emailItem.Display

Set emailItem = Nothing
Set emailApplication = Nothing

End Sub

Thanks,
Paulo

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[JamesCanale]

Instead of a hyperlink to run the email, I'd create a custom function that took one argument:
=emailiffinished(row(C2))
If C2 was the cell with the drop down of department.

Now your function has the row of interest (for the data to customize the email) and will only fire when you change cell C2.

Have your function check that B2 (say the percentage complete) is 100% and C2 has some value. If so it fires off the email and returns "Complete" otherwise "Incomplete". Then you can drag down your function to all of the rows of data and your code is simple.