Send e-mail dependant on specific cell contents - vba

Question

I am a novice VBA programmer and I have searched for this but am unable to find a solution that exactly matches what I need.
I have a code to ping out customer's IP address but I only need e-mail notifications for the pings that have timed out.
The ping results are in column D and the e-mails are in column E of my spreadsheet. I'd be grateful for any help.
Thanks in advance.
Dim OutlookApp
Dim objMail
Dim x As Long
Dim PingResults As range
lastrow = Sheets("Ping").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lastrow
Set PingResults = range("d2:D250")
Set OutlookApp = CreateObject("Outlook.Application")
Set objMail = OutlookApp.CreateItem(olMailItem)
If PingResults.Cells.Value = "Request timed out." Then
objMail.To = Cells(x, 5).Value
With objMail
.Subject = Cells(x, 1) & " " & "-" & " " & Cells(x, 2) & " " & "-" & " " & Cells(x, 3)
.Body = "Run Diagnostics. Customer's broadband appears to have issues" & vbCrLf & Cells(x, 4)
.Display
.Save
End With
SendKeys "%{s}", True
ElseIf PingResults.Cells.Value = "" Then
Set OutlookApp = Nothing
Set objMail = Nothing
End If
End Sub

Answer 1

you most probably are after this:
Option Explicit
Sub main()
Dim pingResults As Range, cell As Range
With Sheets("Ping")
With .Range("D1", .Cells(.Rows.Count, "D").End(xlUp))
.AutoFilter Field:=1, Criteria1:="Request timed out."
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Set pingResults = .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
End With
.AutoFilterMode = False
End With
If Not pingResults Is Nothing Then
With CreateObject("Outlook.Application")
For Each cell In pingResults
With .CreateItem(0) '<--| olMailItem is an item of an OutLook enumeration whose value is "zero"
.Display
.to = cell.Offset(, 1).Value
.Subject = cell.Offset(, -3) & " " & "-" & " " & cell.Offset(, -2) & " " & "-" & " " & cell.Offset(, -1)
.Body = "Run Diagnostics. Customer's broadband appears to have issues" & vbCrLf & cell.Value
.Save
End With
SendKeys "%{s}", True
Next
.Quit
End With
End If
End Sub

Answer 2

This should do it:
Dim OutlookApp
Dim objMail
Dim x As Long
Dim PingResults As Range
Set OutlookApp = CreateObject("Outlook.Application")
lastrow = Sheets("Ping").Cells(Rows.Count, 1).End(xlUp).Row
Set PingResults = Range("d1:D" & lastrow)
For x = 2 To lastrow
If PingResults.Cells(x, 1).Value = "Request timed out." Then
Set objMail = OutlookApp.CreateItem(olMailItem)
With objMail
.To = Cells(x, 5).Value
.Subject = Cells(x, 1) & " " & "-" & " " & Cells(x, 2) & " " & "-" & " " & Cells(x, 3)
.Body = "Run Diagnostics. Customer's broadband appears to have issues" & vbCrLf & Cells(x, 4)
.Display
.Save
End With
SendKeys "%{s}", True
Set objMail = Nothing
End If
Next x
Set OutlookApp = Nothing