Do While

[mulholm]

I have a spreadsheet that looks like:

Wrap	Week 40	Week 41
Agent 1	0:05:00	0:08:20
Agent 2	0:06:40	0:03:20
Agent 3	0:05:00	0:05:00
	0:00:00	0:00:00

<colgroup><col><col span="2"></colgroup><tbody>
</tbody>

I have the below code to e-mail me to tell me if Week 41 is higher/lower/the same as Week 40:

Private Sub WeeklyDataAnalysis()


Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


Do While i <> "#N/A" Or i <> ""
For i = 2 To 5
       If Sheet1.Range("C" & i).Value > Sheet1.Range("B" & i).Value Then
        If Len(Wrapmessage) = 0 Then
            Wrapmessage = Sheet1.Range("A" & i).Value & " wrap increased by " & _
                Format(Sheet1.Range("C" & i).Value - Sheet1.Range("B" & i).Value, "hh:mm:ss")
        Else
            Wrapmessage = Wrapmessage & vbLf & Sheet1.Range("A" & i).Value & " wrap increased by " & _
                Format(Sheet1.Range("C" & i).Value - Sheet1.Range("B" & i).Value, "hh:mm:ss")
        End If
    End If
Next


For i = 2 To 5
    If Sheet1.Range("C" & i).Value < Sheet1.Range("B" & i).Value Then
        If Len(Wrapmessage) = 0 Then
            Wrapmessage = Sheet1.Range("A" & i).Value & " wrap decreased by " & _
                Format(Sheet1.Range("C" & i).Value - Sheet1.Range("B" & i).Value, "hh:mm:ss")
        Else
            Wrapmessage = Wrapmessage & vbLf & Sheet1.Range("A" & i).Value & " wrap decreased by " & _
                Format(Sheet1.Range("C" & i).Value - Sheet1.Range("B" & i).Value, "hh:mm:ss")
        End If
    End If
Next


For i = 2 To 5
    If Sheet1.Range("C" & i).Value = Sheet1.Range("B" & i).Value Then
        If Len(Wrapmessage) = 0 Then
            Wrapmessage = Sheet1.Range("A" & i).Value & " wrap didn't change "
        Else
            Wrapmessage = Wrapmessage & vbLf & Sheet1.Range("A" & i).Value & " wrap didn't change "
        End If
    End If
Next
Exit Do
Loop


If Len(Wrapmessage) > 0 Then


On Error Resume Next


    With OutMail
        .Display
        .To = "Michael.Mulholland@email.co.uk"
        .CC = ""
        .BCC = ""
        .Subject = "Stats Increase"
        .Body = Wrapmessage
        .Send
    End With
    
End If


End Sub

What i want to the code to do is miss out when column A is blank and then continue until it has reached the end.

Just now it is returning this:

Agent 1 wrap increased by 00:03:20
Agent 2 wrap decreased by 00:03:20
Agent 3 wrap didn't change
wrap didn't change - i don't want this to be here as column A5 has no text.

 

[RoryA]

You could do something like this:

Private Sub WeeklyDataAnalysis()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim i As Long
    Dim WrapmessageUp As String, WrapmessageDown As String, WrapmessageSame As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    For i = 2 To 5
        If Len(Sheet1.Range("A" & i).Value) <> 0 Then
            If Sheet1.Range("C" & i).Value > Sheet1.Range("B" & i).Value Then
                If Len(WrapmessageUp) = 0 Then
                    WrapmessageUp = Sheet1.Range("A" & i).Value & " wrap increased by " & _
                                    Format(Sheet1.Range("C" & i).Value - Sheet1.Range("B" & i).Value, "hh:mm:ss")
                Else
                    WrapmessageUp = WrapmessageUp & vbLf & Sheet1.Range("A" & i).Value & " wrap increased by " & _
                                    Format(Sheet1.Range("C" & i).Value - Sheet1.Range("B" & i).Value, "hh:mm:ss")
                End If
            ElseIf Sheet1.Range("C" & i).Value < Sheet1.Range("B" & i).Value Then
                If Len(WrapmessageDown) = 0 Then
                    WrapmessageDown = Sheet1.Range("A" & i).Value & " wrap decreased by " & _
                                      Format(Sheet1.Range("C" & i).Value - Sheet1.Range("B" & i).Value, "hh:mm:ss")
                Else
                    WrapmessageDown = WrapmessageDown & vbLf & Sheet1.Range("A" & i).Value & " wrap decreased by " & _
                                      Format(Sheet1.Range("C" & i).Value - Sheet1.Range("B" & i).Value, "hh:mm:ss")
                End If
            Else
                If Len(WrapmessageSame) = 0 Then
                    WrapmessageSame = Sheet1.Range("A" & i).Value & " wrap didn't change "
                Else
                    WrapmessageSame = WrapmessageSame & vbLf & Sheet1.Range("A" & i).Value & " wrap didn't change "
                End If
            End If
        End If
    Next


    If Len(WrapmessageUp & WrapmessageDown & WrapmessageSame) > 0 Then


        On Error Resume Next


        With OutMail
            .Display
            .To = "Michael.Mulholland@email.co.uk"
            .CC = ""
            .BCC = ""
            .Subject = "Stats Increase"
            .Body = WrapmessageUp & WrapmessageDown & WrapmessageSame
            .Send
        End With

    End If

End Sub

 

[mulholm]

Worked perfectly.

Thanks for tidying it up as well. I am new to VBA.

 

[RoryA]

Glad to help.

It's always good to limit the amount of looping, especially through worksheet cells.

 

[mulholm]

With OutMail
.Display
.To = "Michael.Mulholland@email.co.uk"
.CC = ""
.BCC = ""
.Subject = "Weekly Stats Analysis"
.Body = "Wrap" & vbNewLine & WrapmessageUp & vbNewLine & WrapmessageDown & vbNewLine & WrapmessageSame

I have managed to get the sheet working perfectly but i have noticed one issue.

When i have noone in my team that has had an increased "Wrap" the code still tries to call "Wrapmessageup" but as there is nothing there is shows as blank which returns something like this:

[FONT=&quot]Wrap[/FONT]

[FONT=&quot]Agent 2 wrap decreased by00:03:20[/FONT]
[FONT=&quot]Agent 3 wrap didn't change [/FONT]
[FONT=&quot]Team Total wrap didn't change [/FONT]
[FONT=&quot]Department Total wrap didn'tchange [/FONT]<o></o>


Is there a way to ignore the message if no-ones wrap increased so i dont have random extra lines in my e-mail.

 

[RoryA]

What do you want it to look like in that instance?

 

[mulholm]

So just now it misses out the "Wrapupmessage" as no-ones wrap increased however I want it to appear in the same format everytime regardless. Something like below.

Wrap
Agent 2 wrap decreased by00:03:20
Agent 3 wrap didn't change
Team Total wrap didn't change
Department Total wrap didn'tchange

 

[RoryA]

Try:

.Body = "Wrap" & IIf(Len(WrapmessageUp) > 0, vbNewLine & WrapmessageUp, vbnullstring) & IIf(Len(WrapmessageDown) > 0, vbNewLine & WrapmessageDown, vbnullstring) & IIf(Len(WrapmessageSame) > 0, vbNewLine & WrapmessageSame, vbnullstring)

 

[mulholm]

Worked a treat

Legend.

 

[RoryA]

Glad to help.