Create loop to go down cell then repeat macro code - vba

Question

I currently have a code that Saves the excel sheet in a PDF based on infomation specific to the text in cell B2, and then attach the PDF into an email and email out to the specific user.
I am unsure how to add a macro to the current code to have the cell in B2 go down the data validation list inbetted and then repeat the macro to send the next person the email specific to them.
This is the current code that I have to save pdf and then email:
Sub AttachActiveSheetPDF()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Title = Range("A1")
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = Range("G5") & "_" & ActiveSheet.Name & ".pdf"
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
With OutlApp.CreateItem(0)
.Subject = Title
.To = Range("B4")
.CC = Range("G3")
.Body = "Hello " & Range("G5") & "," & vbLf & vbLf _
& "Your Summary is attached. If you have any further questions about your selections, please call 1-800-XXX-XXXX." & vbLf & vbLf _
& "Best Regards," & vbLf _
& Application.UserName & vbLf _
& "Implementation Specialist" & vbLf & vbLf
.Attachments.Add PdfFile
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0
End With
' Delete PDF file
Kill PdfFile
' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit
' Release the memory of object variable
Set OutlApp = Nothing
End Sub

Answer 1

I quickly wrote an example to show how to loop through the Data Validation List.
Sub Sample()
Dim ws As Worksheet
Dim acell As Range, DataValCell As Range, tmpRng As Range
Dim s As String
Dim MyAr As Variant
Dim i As Long
Set ws = Sheet1 '<~~> Change this to the relevant sheet
With ws
Set DataValCell = .Range("B2")
'~~> Handles =NamedRange or =$O$17:$O$18
If Left(DataValCell.Validation.Formula1, 1) = "=" Then
s = Mid(DataValCell.Validation.Formula1, 2)
Set tmpRng = .Range(s)
Else '~~> Handles aaa,bbb,ccc,ddd
s = DataValCell.Validation.Formula1
End If
If Not tmpRng Is Nothing Then '~~> Handles =NamedRange or =$O$17:$O$18
For Each acell In tmpRng.Cells
Debug.Print acell.Value
'~~> this is where you loop through the DV List
Next
Else '~~> Handles aaa,bbb,ccc,ddd
MyAr = Split(s, ",")
For i = LBound(MyAr) To UBound(MyAr)
Debug.Print MyAr(i)
'~~> this is where you loop through the DV List
Next i
End If
End With
End Sub