loop through data validation list and carry out print macro - excel

Question

I have a Data validation list which contains Names of Employees each month i manually go through each one and press a print button with the following macro.
Sub PDFActiveSheet()
Dim ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
On Error GoTo errHandler
Set ws = ActiveSheet
'enter name and select folder for file
' start in current workbook folder
strFile = Cells.Range("B1") & " Period " & Cells.Range("J1")
strFile = ThisWorkbook.Path & "\" & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False, _
From:=1, _
To:=2
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
This Prints the sheet out to the pathway where the workbook is saved.
My Data Validation List is in Cell 'B1' Is there a way i can use VBA to loop through the list and print these for me? I Have not been able to really get going doing a draft as using a data validation list in vba is completely new to me.
Sub Loop_Through_List()
Dim Name As Variant
'Dim List As ListBox?
For Each Name in List
Call PDFActiveSheet
Next

Answer 1

You can use something like this:
Sub Loop_Through_List()
Dim cell As Excel.Range
Dim rgDV As Excel.Range
Dim DV_Cell As Excel.Range
Set DV_Cell = Range("B1")
Set rgDV = Application.Range(Mid$(DV_Cell.Validation.Formula1, 2))
For Each cell In rgDV.Cells
DV_Cell.Value = cell.Value
Call PDFActiveSheet
Next
End Sub
Edit: revised code based on comments below:
Sub Loop_Through_List()
Dim cell As Excel.Range
Dim rgDV As Excel.Range
Dim DV_Cell As Excel.Range
Set DV_Cell = Range("B1")
Set rgDV = Application.Range(Mid$(DV_Cell.Validation.Formula1, 2))
For Each cell In rgDV.Cells
DV_Cell.Value = cell.Value
Call PDFActiveSheet
Next
End Sub
Sub PDFActiveSheet()
Dim ws As Worksheet
Dim myFile As Variant
Dim strFile As String
Dim sFolder As String
On Error GoTo errHandler
Set ws = ActiveSheet
'enter name and select folder for file
' start in current workbook folder
strFile = ws.Range("B1").Value & " Period " & ws.Range("J1").Value
sFolder = GetFolder()
If sFolder = "" Then
MsgBox "No folder selected. Code will terminate."
Exit Sub
End If
myFile = sFolder & "\" & strFile
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False, _
From:=1, _
To:=2
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Function GetFolder() As String
Dim dlg As FileDialog
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
dlg.InitialFileName = ThisWorkbook.Path & "\"
dlg.Title = "Select folder to save PDFs"
If dlg.Show = -1 Then
GetFolder = dlg.SelectedItems(1)
End If
End Function