Do While

mulholm

New Member
Joined
Jul 2, 2018
Messages
49
I have a spreadsheet that looks like:

[TABLE="width: 393"]
<colgroup><col><col span="2"></colgroup><tbody>[TR]
[TD]Wrap[/TD]
[TD]Week 40[/TD]
[TD]Week 41[/TD]
[/TR]
[TR]
[TD]Agent 1[/TD]
[TD]0:05:00[/TD]
[TD]0:08:20[/TD]
[/TR]
[TR]
[TD]Agent 2[/TD]
[TD]0:06:40[/TD]
[TD]0:03:20[/TD]
[/TR]
[TR]
[TD]Agent 3[/TD]
[TD]0:05:00[/TD]
[TD]0:05:00[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD]0:00:00[/TD]
[TD]0:00:00
[/TD]
[/TR]
</tbody>[/TABLE]

I have the below code to e-mail me to tell me if Week 41 is higher/lower/the same as Week 40:
Code:
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.
 
Last edited by a moderator:

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
You could do something like this:

Code:
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
 
Upvote 0
Glad to help. :)

It's always good to limit the amount of looping, especially through worksheet cells.
 
Upvote 0
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:p></o:p>


Is there a way to ignore the message if no-ones wrap increased so i dont have random extra lines in my e-mail.
 
Upvote 0
What do you want it to look like in that instance?
 
Upvote 0
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
 
Upvote 0
Try:

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

Forum statistics

Threads
1,223,904
Messages
6,175,295
Members
452,632
Latest member
jladair

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top