VBA - add multiple cc recipients from autofiltered table

[doesnaeaddup]

Hello, this is code that I'm putting in PERSONAL.XLSB

I have a macro that creates an email. That's all working fine. The active sheet is guaranteed to have a table called Table1 which is guaranteed to be autofiltered. Column C contains a list of email addresses. The column heading is "Client email".

I want to add all the visible email addresses from column C as .CC recipients of the email, but I'm absolutely stuck as to how to do that.

Can anyone help? Thank you

 

[saboh12617]

Hello,

You can use a little loop like so, and also since you are using O365 you can take advantage of the TEXTJOIN function.

With the example table below, here is a simple code:

Public Sub example()
  Sheet1.Range("A1").AutoFilter
  Sheet1.Range("A1").AutoFilter 1, 1
  Dim vals() As Variant, i As Long, c As Range
  With Sheet1.Range("B1")
    With Range(.Offset(1), .End(xlDown)).SpecialCells(xlCellTypeVisible)
      ReDim vals(0 To .Count - 1)
      For Each c In .Cells
        vals(i) = c.Value2
        i = i + 1
      Next c
    End With
    ' below you get the string to use as CC argument (myMail.CC)
    ' i did put the result in the C1 cell for the example
    .Offset(0, 1).Value2 = WorksheetFunction.TextJoin(";", True, vals)
  End With
End Sub

 

[Tupe77]

Do you mean something like this?

Call it with range. (Range with first email address)
It expands range to end of continuous area ja
return emails in string.

.CC = ccList(Worksheets("Sheet1").Range("C40"))

Function ccList(ListRNG As Range) As String

Dim tempSTR As String
Dim c As Variant
' Expand range from first cell with email to last cell with email
Set ListRNG = Range(ListRNG, ListRNG.End(xlDown))

For Each c In ListRNG.Cells
    tempSTR = tempSTR & c.value & ";"
Next c

ccList = tempSTR
End Function

My apologies for any quirks, English is not my native language. "So I blame Google translate for all my goofs."

 

[Tupe77]

My apologies, I misread the title and the previous version didn't take autofilter into account.

Function ccList(ListRNG As Range) As String

Dim tempSTR As String
Dim c As Variant

' Expanding range from first cell with email to last cell with email
Set ListRNG = Range(ListRNG, ListRNG.End(xlDown))

For Each c In ListRNG.Cells
    ' To skip filtered rows
    If c.EntireRow.Hidden = False Then
        tempSTR = tempSTR & c.value & ";"
    End If
Next c

ccList = tempSTR
End Function

My apologies for any quirks, English is not my native language. "So I blame Google translate for all my goofs."

 

[doesnaeaddup]

Thank you both, I'm very grateful. I used @Tupe77 's solution, just because I could more easily follow the way the final string was put together, though I'm grateful to you too @saboh12617 for your suggestion.

Just one change that I made; I used the following to call the function as I wasn't sure where C40 came from.

.CC = ccList(Worksheets("Sheet1").Range("C2"))

Thanks again

 

[saboh12617]

Thanks for the feedback & glad to help.

For information, the solution in proposed is the equivalent of the Office365 formula below :

=TEXTJOIN(", ", TRUE, FILTER(Table1, Table1[Column1]=1))

Which makes me think that in VBA you could simply call it like so:

Public Sub Example()
  Dim criteria As Variant: criteria = 1
  Sheet2.Range("C1").Value2 = _
    Evaluate("TEXTJOIN("";"", TRUE, FILTER(Table1, Table1[Column1]=""" & criteria & """))")
End Sub

It's probably faster than looping on each cell.

Have a good day.