I found something to get me started, but can't see how to assign the visible cell values to strings. I'm probably not even explaining that correctly.
Here is the start from what I found:
Here are a few filtered rows
I'll be using this to send emails, each unique Group will create one email. Based on the above, one email would be addressed to richard@email.com, and another email would be addressed to josh@email.com;rj@email.com.
I have created a few macros for sending emails, but this is the first attempt at using a filter.
What I can't figure out, is how to write a loop where the loop doesn't look at the hidden rows.
This is something that I created before having the idea of using a filter, it was a bit cumbersome.
Here is the start from what I found:
VBA Code:
Sub test()
Dim cl As Range, rng As Range
Dim lr As Long
Dim eto As String, ecc As String, esubj As String
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range(Cells(2, 1), Cells(lr, 6))
For Each cl In rng
If cl.EntireRow.Hidden = False Then
End If
Next
End SubHere are a few filtered rows
| Email.xlsb | ||||||||
|---|---|---|---|---|---|---|---|---|
| A | B | C | D | E | F | |||
| 1 | Group | Area | Main | First Name | Cell Phone | |||
| 2 | Group1 | 1 | X | Richard | Richard@email.com | |||
| 11 | Group3 | 1 | X | Josh | Josh@email.com | |||
| 12 | Group3 | 1 | X | RJ | RJ@email.com | |||
Sheet3 | ||||||||
I'll be using this to send emails, each unique Group will create one email. Based on the above, one email would be addressed to richard@email.com, and another email would be addressed to josh@email.com;rj@email.com.
I have created a few macros for sending emails, but this is the first attempt at using a filter.
What I can't figure out, is how to write a loop where the loop doesn't look at the hidden rows.
This is something that I created before having the idea of using a filter, it was a bit cumbersome.
VBA Code:
Sub in_work()
Dim OutApp As Object
Dim OutMail As Object
Dim x As Long, i As Long
Dim eto As String, ecc As String, esubj As String
Set OutApp = CreateObject("Outlook.Application")
lr = Cells(Rows.Count, 3).End(xlUp).Row
For i = 11 To 23
Set OutMail = OutApp.CreateItem(0)
With OutMail
If Cells(i, 2).Value = "x" Then
esubj = Cells(i, 1).Value
For x = 2 To lr
If Cells(x, 3).Value = esubj Then
If Cells(8, 2).Value = "x" Then
If Cells(2, 2).Value = "x" Then
If Cells(x, 4).Value = "1" And Cells(x, 5).Value = "X" Then
eto = Cells(x, 8).Value & ";" & eto
End If
End If
If Cells(3, 2).Value = "x" Then
If Cells(x, 4).Value = "2" And Cells(x, 5).Value = "X" Then
eto = Cells(x, 8).Value & ";" & eto
End If
End If
If Cells(4, 2).Value = "x" Then
If Cells(x, 4).Value = "3" And Cells(x, 5).Value = "X" Then
eto = Cells(x, 8).Value & ";" & eto
End If
End If
If Cells(5, 2).Value = "x" Then
If Cells(x, 4).Value = "4" And Cells(x, 5).Value = "X" Then
eto = Cells(x, 8).Value & ";" & eto
End If
End If
If Cells(6, 2).Value = "x" Then
If Cells(x, 4).Value = "5" And Cells(x, 5).Value = "X" Then
ecc = Cells(x, 8).Value & ";" & ecc
End If
End If
ElseIf Cells(8, 2).Value = "" Then
If Cells(2, 2).Value = "x" Then
If Cells(x, 4).Value = "1" Then
eto = Cells(x, 8).Value & ";" & eto
End If
End If
If Cells(3, 2).Value = "x" Then
If Cells(x, 4).Value = "2" Then
eto = Cells(x, 8).Value & ";" & eto
End If
End If
If Cells(4, 2).Value = "x" Then
If Cells(x, 4).Value = "3" Then
eto = Cells(x, 8).Value & ";" & eto
End If
End If
If Cells(5, 2).Value = "x" Then
If Cells(x, 4).Value = "4" Then
eto = Cells(x, 8).Value & ";" & eto
End If
End If
If Cells(6, 2).Value = "x" Then
If Cells(x, 4).Value = "5" Then
ecc = Cells(x, 8).Value & ";" & ecc
End If
End If
End If
End If
Next x
.To = eto
.cc = ecc
.Subject = esubj
.Display
End If
End With
eto = ""
ecc = ""
Next i
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
