Matthew Bond
Matthew Bond

Reputation: 191

loop through data validation list and carry out print macro

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

Upvotes: 1

Views: 4897

Answers (1)

Rory
Rory

Reputation: 34045

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

Upvotes: 1

Related Questions