Clean up Code

JRR1229

New Member
Joined
Jun 23, 2020
Messages
11
Office Version
  1. 2016
Platform
  1. Windows
I wrote this part of a code to cycle through two columns of emails and company names and add them to a BCC line of an email. The first part cycles through the emails that the person chooses by checking check boxes next to the email. the send part cycles through the company names of the emails and checks to see if there are any companies that require to have another email added to the BCC line in addition to the one with the check box. I want to know if there is a way of cleaning this up to do the same thing. I have tried the Select Case and ElseIf Commands with no success.
VBA Code:
' Strings to contain the email addresses
     Dim sendBCC As String

' The cell containing the email address (loop variable)
     Dim emailCell As Range
     With Worksheets(M)

' Cycle through email addresses, from C5 to one before next blank cell in column
     For Each emailCell In .Range("C4", .Range("C4").End(xlDown))
     
' Check each TRUE/FALSE column in same row, add email addresses accordingly
     If .Cells(emailCell.Row, "N").Text = "TRUE" Then
          sendBCC = sendBCC & "; " & emailCell.Text
          
     End If

     Next emailCell
     
' Strings to contain the company
     Dim companyBCC As String

' The cell containing the company(loop variable)
     Dim companyCell As Range

' Cycle through email addresses, from D5 to one before next blank cell in column
     For Each companyCell In .Range("D4", .Range("D4").End(xlDown))
     
' Check each TRUE/FALSE column in same row, add company accordingly
     If .Cells(companyCell.Row, "N").Text = "TRUE" Then
          companyBCC = companyBCC & ", " & companyCell.Text
     
     End If
     
     Next companyCell
     
     If InStr(1, companyBCC, "Their Company") Then
          sendBCC = sendBCC & "; " & "theircompany@whatever.com"
     End If
     
     If InStr(1, companyBCC, "Any Company") Then
          sendBCC = sendBCC & "; " & "anycompany@whatever.com"
     End If
     
     If InStr(1, companyBCC, "This Company") Then
          sendBCC = sendBCC & "; " & "thiscompany@whatever.com"
     End If
     
     If InStr(1, companyBCC, "My Company") Then
          sendBCC = sendBCC & "; " & "mycompany@whatever.com"
     End If
     
     If InStr(1, companyBCC, "LLC") Then
          sendBCC = sendBCC & "; " & "llc@whatever.com"
     End If
     
     If InStr(1, companyBCC, "Said Company") Then
          sendBCC = sendBCC & "; " & "saidcompany@whatever.com"
     End If
     
     If InStr(1, companyBCC, "Company") Then
          sendBCC = sendBCC & "; " & "company@whatever.com"
     End If
     
     If InStr(1, companyBCC, "Company Name") Then
          sendBCC = sendBCC & "; " & "companyname@whatever.com"
     End If
     
     If InStr(1, companyBCC, "Example Company") Then
          sendBCC = sendBCC & "; " & "examplecompany@whatever.com"
     End If
     
     End With

     On Error Resume Next
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,770
Office Version
  1. 2016
Platform
  1. Windows
What about this?

VBA Code:
' Strings to contain the email addresses
Dim sendBCC         As String

' The cell containing the email address (loop variable)
Dim emailCell       As Range
With Worksheets(M)
    
    ' Cycle through email addresses, from C5 to one before next blank cell in column
    For Each emailCell In .Range("C4", .Range("C4").End(xlDown))
        ' Check each TRUE/FALSE column in same row, add email addresses accordingly
        If .Cells(emailCell.Row, "N").Text = "TRUE" Then
            sendBCC = sendBCC & "; " & emailCell.Text
        End If
    Next emailCell
    
    ' Strings to contain the company
    Dim companyBCC  As String
    
    ' The cell containing the company(loop variable)
    Dim companyCell As Range
    
    ' Cycle through email addresses, from D5 to one before next blank cell in column
    For Each companyCell In .Range("D4", .Range("D4").End(xlDown))
        ' Check each TRUE/FALSE column in same row, add company accordingly
        If .Cells(companyCell.Row, "N").Text = "TRUE" Then
            companyBCC = companyBCC & ", " & companyCell.Text
        End If
    Next companyCell
    
    ' Create a collection of companies' name
    Dim collCompany As New Collection
    
    collCompany.Add "Their Company"
    collCompany.Add "Any Company"
    collCompany.Add "This Company"
    collCompany.Add "My Company"
    collCompany.Add "LLC"
    collCompany.Add "said Company"
    collCompany.Add "Company"
    collCompany.Add "Company Name"
    collCompany.Add "Example Company"
    
    Dim coName As Variant
    
    For Each coName In collCompany
        If InStr(companyBCC, coName) Then
            sendBCC = sendBCC & "; " & coName & "@whatever.com"
        End If
    Next
        
End With
 

JRR1229

New Member
Joined
Jun 23, 2020
Messages
11
Office Version
  1. 2016
Platform
  1. Windows
I think by @whatever.com was a bad thing to put after everyone of the companies emails. Every email recipient will have a different domain name as well
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,770
Office Version
  1. 2016
Platform
  1. Windows
I think by @whatever.com was a bad thing to put after everyone of the companies emails. Every email recipient will have a different domain name as well
I looked at your code and it is all @WHATEVER. I thought all same domain ☺️

If you want each company name paired with own domain name, then probably it is easier to use Dictionary where it is easier to get key and item pair as company and domain perhaps.

 

Forum statistics

Threads
1,144,370
Messages
5,723,960
Members
422,529
Latest member
mbilal429

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
Top