- Joined
- May 10, 2012
- Messages
- 6
- Reaction score
- 0
Hello. I am still relatively new to using Macros in Excel and have been doing a lot of experimenting and researching, but am having difficulty getting the right code. When the test result is transferred from my Test Sheet to my Test Tracker sheet, it goes in column H3. The pass for the test is 60. So when the result is >59 I want "Passed" to be inserted in the J3 column. If the result is <60 then I want "Failed" to be inserted in the J3 column. Also, as soon as the test result and the Pass/Fail results are inserted, I have it programmed to send an email automatically for a pass or a fail. Right now I have to insert Passed or Failed into J3 manually before the test result is inserted, in order for the email to send out. I am using Excel 97-2003.
The codes are below.
This is in my Instructors worksheet of the Test Tracker Workbook
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("H3"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value > 59 Then
Call SendEmail
Else
If IsNumeric(Target.Value) And Target.Value < 60 Then
Call SendEmail
End If
End If
End If
End Sub
This in a Module of the Test Tracker Workbook
Sub SendEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("I").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "J").Value) = "passed" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "IST TEST RESULT"
.Body = "" & Cells(cell.Row, "B").Value _
& Cells(cell.Row, "C").Value _
& vbNewLine & vbNewLine & _
"You passed with " & _
Cells(cell.Row, "H").Value _
& "%" & _
vbNewLine & vbNewLine & _
"Your particulars will be added" & _
" to the Brigade IST Database."
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
On Error GoTo 0
Cells(cell.Row, "J").Value = "sent acceptance e-mail"
Set OutMail = Nothing
Else
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "J").Value) = "failed" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "IST TEST RESULT"
.Body = "" & Cells(cell.Row, "B").Value _
& Cells(cell.Row, "C").Value _
& vbNewLine & vbNewLine & _
"Your test result was " & _
Cells(cell.Row, "H").Value _
& "%" & _
vbNewLine & vbNewLine & _
"You will need to do a re-test " & _
" Please let me know when you are ready for another test."
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
On Error GoTo 0
Cells(cell.Row, "J").Value = "sent failed e-mail"
Set OutMail = Nothing
End If
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
The codes are below.
This is in my Instructors worksheet of the Test Tracker Workbook
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("H3"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value > 59 Then
Call SendEmail
Else
If IsNumeric(Target.Value) And Target.Value < 60 Then
Call SendEmail
End If
End If
End If
End Sub
This in a Module of the Test Tracker Workbook
Sub SendEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("I").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "J").Value) = "passed" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "IST TEST RESULT"
.Body = "" & Cells(cell.Row, "B").Value _
& Cells(cell.Row, "C").Value _
& vbNewLine & vbNewLine & _
"You passed with " & _
Cells(cell.Row, "H").Value _
& "%" & _
vbNewLine & vbNewLine & _
"Your particulars will be added" & _
" to the Brigade IST Database."
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
On Error GoTo 0
Cells(cell.Row, "J").Value = "sent acceptance e-mail"
Set OutMail = Nothing
Else
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "J").Value) = "failed" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "IST TEST RESULT"
.Body = "" & Cells(cell.Row, "B").Value _
& Cells(cell.Row, "C").Value _
& vbNewLine & vbNewLine & _
"Your test result was " & _
Cells(cell.Row, "H").Value _
& "%" & _
vbNewLine & vbNewLine & _
"You will need to do a re-test " & _
" Please let me know when you are ready for another test."
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
On Error GoTo 0
Cells(cell.Row, "J").Value = "sent failed e-mail"
Set OutMail = Nothing
End If
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub