Select Range based on list a looping list to send as an email

[JSuarez]

I'm looking to use a list in a column to loop through to select each qualifying range to email e.g.:

Column AC - AF and rows are selected according to the qualifier (Owner)/variable, when I run the script (Frankenstein) first loops is correct, but the second adds the the first plus the second selection, and so on. This is a sample of possible 200 entries, which would fluctuate progressively. I think the problem is at Sub SelectByCellValue. The code is rough, but I'm trying to keep notes for each step for now. Any help to get this correct and/or improved would be appreciated!

AC	AD	AE	AF		AO	AP
ID#	S/N	Alias	Owner		List	Email
UID1	S/N1	Alias1	Usr1		Usr1	Usr1@xxx.com
UID1	S/N2	Alias2	Usr1		Usr2	Usr2@xxx.com
UID1	S/N3	Alias3	Usr2		Usr3	Usr3@xxx.com

<tbody>
</tbody>

Sub SelectActiveList()
'https://www.wiseowl.co.uk/blog/s193/for-each-next.htm
'a reference to the first Muppet


Dim TopCell As Range


'references to:


'- the range of Muppets; and


'- each individual Muppet cell


'a reference to each cell in the muppet names column


Dim MuppetRange As Range


Dim MuppetCell As Range


'first check there is a top cell to start from


Set TopCell = Cells.Find("Active List")


If TopCell Is Nothing Then


MsgBox "Can not find top of column, where is Active List Header name?"


Exit Sub


End If


'get a reference to the column of muppets


Set MuppetRange = Range(TopCell.Offset(1, 0), TopCell.End(xlDown))


'now look at each muppet in turn in this block


For Each MuppetCell In MuppetRange


'if this has rating more than 5 in column D ...


If IsEmpty(MuppetCell) = False Then


'colour entire row blue


'Range(MuppetCell, MuppetCell.End(xlToRight)).Interior.ColorIndex = 20








'Sub SelectByCellValue()
'UpdatebyExtendoffice20161128
    Dim LastRow As Long
    Dim xRg As Range, yRg As Range
    'change Sheet1 to suit
    With ThisWorkbook.Worksheets("Sheet1")
        LastRow = .Cells(.Rows.Count, "AG").End(xlUp).row
        Application.ScreenUpdating = False
        For Each xRg In .Range("AG1:AG" & LastRow)
            If UCase(xRg.text) = MuppetCell Then
                If yRg Is Nothing Then
                    Set yRg = .Range("AC" & xRg.row).Resize(, 5)
                Else
                    Set yRg = Union(yRg, .Range("AC" & xRg.row).Resize(, 5))
                End If
            End If
        Next xRg
        Application.ScreenUpdating = True
    End With
 
    If Not yRg Is Nothing Then yRg.Select
    
'End Sub


    If MsgBox("Is this correct! Are you sure?", vbYesNo) = vbNo Then Exit Sub








'Sub Mail_Selection_Range_Outlook_Body()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2016
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object


    Set rng = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    'Set rng = Selection.SpecialCells(xlCellTypeVisible) 'Orginal info.
    'Range("AC" & (ActiveCell.row), Selection).Resize(, 5).Select
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    
    
    'You can also use a fixed range if you want
    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0


    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If


    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        .To = MuppetCell.Offset(0, 1).Value
        .CC = "x"
        .BCC = ""
        .Subject = "Lunch"
        .HTMLBody = "Hello" & RangetoHTML(rng)
        .Display   'or use .Display or .Send
    End With
    On Error GoTo 0


    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With


    Set OutMail = Nothing
    Set OutApp = Nothing
'End Sub


'rng = vbNullString












End If


Next MuppetCell


End Sub

 

[Logit]

.
Let me understand what your overall goal is relating only to the email portion.

You want to use the email address from Col AP, and paste the cell values from AC / AD / AE / AF / AO in the body of the email.

Then you want the email to drop to the next email address below in Col AP and repeat the process, etc. etc.

Is this correct ?

 

[JSuarez]

.
Let me understand what your overall goal is relating only to the email portion.

You want to use the email address from Col AP, and paste the cell values from AC / AD / AE / AF / AO in the body of the email.

Then you want the email to drop to the next email address below in Col AP and repeat the process, etc. etc.

Is this correct ?

My script is probably so convoluted it's probably hard to follow. I can get the email portion to work and loop through each of the different email addresses, but it's the selection AC-AF I'm having problems with. The list in the AO column e.g. Usr1, is suppose to select All instances of Usr1 from AF, include data (Rows) through Column AC, and send it as the body in an email. Continue to next to Usr2 and select all instances of Usr2 in column AF-AC, and repeat, but the problem I'm having is instead of resetting the AF-AC selection to the next Usr "Usr2" it expands the range to include the previous Selection from Usr1. Basically it is expanding data or cells from Usr1 AF-AC selection through to include Usr2 on second email and so on for the next loop item in the list.

 

[Logit]

.
I'm having a difficult time following the code.

My only "stab" at this is :

What happens if you comment out one of the SET lines of code :

If yRg Is Nothing Then
                    Set yRg = .Range("AC" & xRg.row).Resize(, 5)
Else
                    Set yRg = Union(yRg, .Range("AC" & xRg.row).Resize(, 5))
End If

 

[JSuarez]

Result: Invalid or Unqualified reference...

 

[JSuarez]

Apologies, but comment out? Your dealing with a green noob!

 

[Logit]

.
Place a single quote symbol ( ' ) in front of one line and run the code.

If that doesn't work, place the symbol in front of the other line of code and try it again.

 

[JSuarez]

I over complicated your suggestion. No, this did not work. By applying your suggestion the script either does the first line only for a selection or nothing for the second item.

 

[Logit]

.
Sorry that did not solve the problem. Hopefully someone more knowledgeable than I will assist.

All the best !

 

[JSuarez]

I appreciate the effort and hopefully, I can get an assist to be able to share this when properly setup.