Check Box Email

[JRR1229]

I have a column of check boxes that corrisboned with Contact information to clients. I already have a command button that will open a new email, with populated body, and add all the emails in the list to all the BCC (see code below). I am trying to change it where I can choose what emails will be added to the BCC by checking the box and then hitting the command button.

Private Sub Email_Click()
'Unprotect Sheet
     ActiveSheet.Unprotect ("NEXTELECTRIC")

'Setting up the Excel variables.
   Dim olApp As Object
   Dim olMailItm As Object
   Dim iCounter As Integer
   Dim Dest As Variant
   Dim SDest As String
    
  
   'Create the Outlook application and the empty email.
   Set olApp = CreateObject("Outlook.Application")
   Set olMailItm = olApp.CreateItem(0)
  
   'Body of Email
   xRFQBody = "Good Morning Afternoon," & vbCrLf & vbCrLf & "Please provide a * quote for the * project. This quote is for a bid." & _
   vbCrLf & vbCrLf & "Response by * is needed." & _
   vbCrLf & vbCrLf & _
   "o          All materials must comply with the project specifications and drawings" & vbCrLf & _
   "o          Provide quantities and unit prices for attic stock per specifications if applicable" & vbCrLf & _
   "o          All orders to be FOB destination" & vbCrLf & _
   vbCrLf & "See link for additional information" & _
   vbCrLf & vbCrLf & vbCrLf & "Feel free to contact me with any questions." & _
   vbCrLf & vbCrLf
  
  
   'Using the email, add multiple recipients, using a list of addresses in column A.
   With olMailItm
       SDest = ""
       For iCounter = 5 To WorksheetFunction.CountA(Columns(5))
           If SDest = "" Then
               SDest = Cells(iCounter, 4).Value
           Else
               SDest = SDest & ";" & Cells(iCounter, 3).Value
           End If
       Next iCounter
      
    'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
       .BCC = SDest
       .Subject = "RFQ"
       .Body = xRFQBody
       .Display
   End With
  
   'Clean up the Outlook application.
   Set olMailItm = Nothing
   Set olApp = Nothing
  
'Protect Sheet
     ActiveSheet.Protect ("NEXTELECTRIC")
  
End Sub