title: If loops on Excel for multiple options
body: <p>I have the below code set up to draft an email based on the value in column B which works fine. (If there is any text in column A it will run this) </p>
  
  <p>Column B could have any of 25 options which are on the <code>Statuses</code> worksheet also, alongside the relevant email address relating to each option which is then entered  in the <code>.To</code> field. I'm wondering if there's any way that I can run the if loop without having to write each section out and amend 25 times (the below code shows two of the 25)</p>
  
  <pre><code>Option Explicit
  Option Compare Text 'ignore case sensitivity when comparing strings
  
  Sub SendDraft()
  
  Dim objOutlook As Object
  Dim objMail As Object
  Dim OL As Outlook.Application, ES As Worksheet, r As Long, i As Long
  Set objOutlook = CreateObject("Outlook.Application")
  Set objMail = objOutlook.CreateItem(0)
  Dim path As String
  Dim body As String
  Dim body2 As String
  Dim body3 As String
  Dim body4 As String
  
  
  body = ",&lt;br&gt;&lt;br&gt;Please find attached a draft invoice for "
  body2 = "&lt;br&gt;&lt;br&gt;Please respond with any agreement or dispute no later than 4:30pm on &lt;b&gt;"
  body3 = "&lt;/b&gt;, otherwise a full invoice will be raised to the value of the attached draft.&lt;br&gt;&lt;br&gt;Many thanks,"
  
  
      r = Cells(Rows.Count, 1).End(xlUp).Row
      For i = 3 To r
      With Cells(i, 1)
  
              If .Value &lt;&gt; "" And Cells(i, 2) = Sheets("Statuses").Range("G6").Value Then
                      Set objOutlook = CreateObject("Outlook.Application")
                      Set objMail = objOutlook.CreateItem(0)
                      With objMail
                      .SentOnBehalfOfName = "xxx@xxx.com"
                      .To = Sheets("Statuses").Range("H6").Value &amp; ";" &amp; Sheets("Statuses").Range("I6").Value
                      .CC = "xxx@xxx.com"
                      .Subject = "Your " &amp; Cells(i, 5).Value &amp; " licence - " &amp; Cells(i, 4).Value
                      .HTMLBody = "Dear " &amp; Cells(i, 2) &amp; body &amp; Cells(i, 26).Text &amp; " defect charges." &amp; body2 &amp; Cells(i, 27).Text &amp; body3
                      .Display
  
  End With
  End If
  
  If .Value &lt;&gt; "" And Cells(i, 2) = Sheets("Statuses").Range("G7").Value Then
                      Set objOutlook = CreateObject("Outlook.Application")
                      Set objMail = objOutlook.CreateItem(0)
                      With objMail
                      .SentOnBehalfOfName = "xxx@xxx.com"
                      .To = Sheets("Statuses").Range("H7").Value &amp; ";" &amp; Sheets("Statuses").Range("I7").Value
                      .CC = "xxx@xxx.com"
                      .Subject = "Your " &amp; Cells(i, 5).Value &amp; " licence - " &amp; Cells(i, 4).Value
                      .HTMLBody = "Dear " &amp; Cells(i, 2) &amp; body &amp; Cells(i, 26).Text &amp; " defect charges." &amp; body2 &amp; Cells(i, 27).Text &amp; body3
                      .Display
  
  End With
  End If
  End With
  
  Next i
  
  If WorksheetFunction.CountA(Range("a3:a1000")) = 0 Then
          MsgBox "No draft charge(s) to send - please enter text in column A for the appropriate draft charge(s) you wish to send."
  End If
  
  Set objOutlook = Nothing
  Set objMail = Nothing
  
  
  End Sub
  </code></pre>