VBA continues to run, I have to press "esc" to end the code

Question

'Just trying to find a way to clean the code up so I dont have to press esc eveytime.

Sub Email_From_Excel_Basic()

Dim emailApplication As Object
Dim emailItem As Object
Dim mymsg As String
Dim cell As Range

Application.ScreenUpdating = False
Set emailApplication = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Worksheets("owssvr").Columns("S").Cells
    Set emailItem = emailApplication.CreateItem(0)

'They say the error is found in these two lines below. The (IF and Cells)

    If cell.Value Like "?*@?*.?*" And _
    Cells(cell.Row, "T") = "Yes" Then

'The next part below should be fine.

        With emailItem

        .To = Cells(cell.Row, "R").Value & ";" & Cells(cell.Row, "S").Value
        .CC = Cells(cell.Row, "S").Value & ";" & Cells(cell.Row, "S").Value & ";" & Cells(cell.Row, "S").Value

        .Subject = "Status update on your recent order"

        mymsg = "Dear " & Cells(cell.Row, "A").Value & " team," & vbNewLine & vbNewLine
        Dim stts As String
        If Cells(cell.Row, 4).Value = "1. New Order" Then
            stts = "Your order has been received and will be processed."
        ElseIf Cells(cell.Row, 4).Value = "2. Shipped" Then
            stts = "Your order has been shipped"
        ElseIf Cells(cell.Row, 4).Value = "3. In-Process" Then
            stts = "Your order has been received. We are waiting on information to confirm your order."
        ElseIf Cells(cell.Row, 4).Value = "5. Approved" Then
            stts = "Your order is approved to ship."
        Else
        End If

        mymsg = mymsg & "Status: " & stts & vbNewLine
        mymsg = mymsg & "Expected delivery: " & Cells(cell.Row, "AF").Value & vbNewLine & vbNewLine
        mymsg = mymsg & "Project contact: " & Cells(cell.Row, "Z").Value & vbNewLine
        mymsg = mymsg & "Email: " & Cells(cell.Row, "AA").Value & vbNewLine
        mymsg = mymsg & "Phone: " & Cells(cell.Row, "AB").Value & vbNewLine & vbNewLine
        mymsg = mymsg & "*This is only an estimate. Please reach out to your project contact for further information." & vbNewLine & vbNewLine
        mymsg = mymsg & "Best regards" & vbNewLine & vbNewLine
        .Body = mymsg
        .Send

'Could the cleanup be the issue?

        End With
    Set emailItem = Nothing
    End If
Next cell

cleanup:
Set emailApplication = Nothing
Application.ScreenUpdating = True
End Sub

[Find the last row](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba) instead of looping over each cell in the column with `For Each cell In Worksheets("owssvr").Columns("S").Cells`. — BigBen, Mar 20 '20 at 19:15
With Sheets("owssvr") LastRow = .Range("S" & .Rows.Count).End(xlUp).Row End With — Jay, Mar 20 '20 at 19:20
Yes and then you'd need to change your `For` loop to reflect `LastRow`. — BigBen, Mar 20 '20 at 19:22
For example, `For Each cell In Worksheets("owssvr").Range("S2:S" & LastRow)` instead of `For Each cell In Worksheets("owssvr").Columns("S").Cells`. Change the `2` in `S2` as needed, I'm assuming you have a header but it might not be the case. — BigBen, Mar 20 '20 at 19:27

score 1 · Accepted Answer · answered Mar 20 '20 at 19:34

For Each cell In Worksheets("owssvr").Columns("S").Cells

This includes all the blank cells in column S that you should not loop over.

Find the last row:

With Sheets("owssvr") 
    LastRow = .Range("S" & .Rows.Count).End(xlUp).Row 
End With

And now loop over just the cells you need (change the S2 as needed):

For Each cell In Worksheets("owssvr").Range("S2:S" & LastRow)

VBA continues to run, I have to press "esc" to end the code

1 Answers1