Excel Loop Email Template

[JeanPyerC]

Hi Team, I am having issues trying to create a loop for this Macro I build. The goal is to have excel run a basic standard email to our vendors, however, I cannot seem to find a loop to move on to the next range.
Right now the Range is for C4:D4, after the email is complete I want the same action to begin but for C5:D5, and stops when it hits a blank.

Thank you all so much for helping, I am excited to see this.


MACRO
Sub Email_Template()

Dim emailApplication As Object
Dim emailItem As Object
Dim emailRng As Range, CL As Range
Dim sTO As String

' C - Primary Email / D - Secondary Email
Set emailRng = Worksheets("Sheet1").Range("C4:D4")

For Each CL In emailRng
sTO = sTO & ";" & CL.Value
Next

sTO = Mid(sTO, 2)


Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)

' Building the email'

emailItem.to = sTO
emailItem.Subject = "UPDATE"
emailItem.Body = "TEST TEST TEST"


emailItem.Display
'emailItem.Send

Set emailItem = Nothing
Set emailApplication = Nothing

End Sub

 

[GWteB]

How about

Sub Email_Template()

    Dim emailApplication As Object
    Dim emailItem As Object
    Dim emailRng As Range, CL As Range
    Dim sTO As String

    ' C - Primary Email / D - Secondary Email
    Set emailRng = Worksheets("Sheet1").Range("C4:D4")

    Set emailApplication = CreateObject("Outlook.Application")

    While Not emailRng.Cells(1, 1).Value = vbNullString

        For Each CL In emailRng
            sTO = sTO & ";" & CL.Value
        Next
        sTO = Mid(sTO, 2)

        Set emailItem = emailApplication.CreateItem(0)

        ' Building the email'
        emailItem.to = sTO
        emailItem.Subject = "UPDATE"
        emailItem.Body = "TEST TEST TEST"

        emailItem.Display
        'emailItem.Send

        sTO = vbNullString
        Set emailRng = emailRng.Offset(1, 0)

    Wend

    Set emailItem = Nothing
    Set emailApplication = Nothing

End Sub

 

[JeanPyerC]

Thank you!!!! This actually solved my issue! Can I ask how you did it, I see the formula but I want to make sure I am understanding.

 

[GWteB]

You are welcome and thanks for the feedback.
For your clarity:

Set emailRng = Worksheets("Sheet1").Range("C4:D4")          ' set reference to your initial range
Set emailApplication = CreateObject("Outlook.Application")  ' get this one out of any loop
While Not emailRng.Cells(1, 1).Value = vbNullString         ' check if very first cell of reference range is empty
                                                            ' as long as it's not empty proceed, otherwise branche to first statement after Wend
    sTO = vbNullString                                      ' clear sTO
    Set emailRng = emailRng.Offset(1, 0)                    ' set new reference range based on the previous, with a relative displacement of 1 row and 0 columns
Wend                                                        ' branche to While
Set emailItem = Nothing                                     ' first statement after wend