none
Macro loop through dropdown and save as pdf RRS feed

  • Question

  • Dear all

    I've searched the interweb and came across many part-solutions, however, the script I wrote gives me errors and I can't find the right order to place the steps.

    I have an excel containing a dropdown in cell D1 of Sheet Station Dashboard, the list of entries for that dropdown is in the Sheet "Station Mapping"("A2:A140")

    I want the excel to go through that dropdown, and save a pdf in the folder location that is stored in Cell K7 (linked with a VLOOKUP formula, depending on the station selected).

    Here's what i got:

    Sub SaveAllPDFs()
    
    Dim cell As Range
    Dim Dashboard As Worksheet
    Dim counter As Long
    Dim location As String
    Dim PdfName As String, Title As String
    
      ActiveWorkbook.Save
    
        Set Dashboard = Sheets("Station Dashboard")
       
        For Each cell In Sheets("Station Mapping").Range("A2:A140")
        location = Range("K7")
        PdfName = location & Application.PathSeparator & Range("D1") & "-" & Range("D7") & ".pdf"
          If Not IsEmpty(cell) Then
             With Dashboard
                .Range("D1").Value = cell.Value
                .ExportAsFixedFormat Type:=xlTypePDF, filename:=PdfName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
             End With
          End If
       Next cell
        Set Dashboard = Nothing
    End Sub

    The debugger tells me that the .ExportAsFixedFormat created a runtime error (1004). Document may be open or an error occured whilst saving.

    Thanks for your help! appreciate it.
    Best regards, Joel

    Wednesday, July 26, 2017 10:17 AM

All replies


  •     location = Range("K7")
        PdfName = location & Application.PathSeparator & Range("D1") & "-" & Range("D7") & ".pdf"

    IMHO it is obvious that the chance for an invalid path and/or the filename is high.

    If you need further help please upload your file (maybe with anonymous data) on an online file hoster like www.dropbox.com and post the download link here.

    A macro to anonymize data in selected cells can be downloaded here:
    https://www.dropbox.com/s/rkfxuh85j5wyj9y/modAnonymize.bas?dl=1

    Andreas.

    Wednesday, July 26, 2017 1:58 PM
  • Dear Andreas

    Thanks for your feedback. I have managed to get it running and it is working as it should but as you rightfully mention, sometimes it crashes and returns a runtime error.

    Sub SaveAllPDFs()
    
    Dim cell As Range
    Dim Dashboard As Worksheet
    Dim counter As Long
    Dim location As String
    Dim PdfName As String, Title As String
    
    
    
    Set Dashboard = Sheets("Station Dashboard")
       
       PdfName = location & Application.PathSeparator & Range("D1") & "-" & Range("D7") & ".pdf"
    
        For Each cell In Sheets("Station Mapping").Range("A2:A140")
          If Not IsEmpty(cell) Then
             With Dashboard
                .Range("D1").Value = cell.Value
                location = Range("K7")
                PdfName = location & Application.PathSeparator & Range("D1") & "-" & Range("D7") & ".pdf"
                .ExportAsFixedFormat _
                      Type:=xlTypePDF, _
                      filename:=PdfName, _
                      Quality:=xlQualityStandard, _
                      IncludeDocProperties:=True, _
                      IgnorePrintAreas:=False, _
                      OpenAfterPublish:=False
             End With
          End If
       Next cell
       
       Set Dashboard = Nothing
        
        End Sub
    
    

    How can I solve this?

    Thanks!

    Joël

    Thursday, July 27, 2017 11:53 AM
  • you rightfully mention, sometimes it crashes and returns a runtime error.

    How can I solve this?

    I can not answer the question why, because it's up to you to find the path\filename issue.

    But in general you should always use an error handler in critical macros, e.g.:

      'At the start of a sub
      Dim Failed As Boolean
      On Error GoTo Errorhandler

      'Your code here
     
      'At the end
      If Failed Then
        MsgBox "Not all PDF's are created..."
      End If
      Exit Sub
    Errorhandler:
      Failed = True
      Debug.Print "Error      : " & Err.Number
      Debug.Print "Description: " & Err.Description
      Debug.Print "PdfName    : " & PdfName
      Resume Next

    Andreas.

    Thursday, July 27, 2017 1:38 PM
  • Hi Andreas

    Thanks a lot for your help!
    The errorhandler tells me at what point the macro crashes. I suspect the error is linked to SharePoint issues, the PDFs get stuck in a queue for the upload, which eventually fails as it cannot find the path (although it exists and is valid) to save the PDF in. To have a workaround, is there any way that the macro simply resets and starts again at the point it crashed? In other words: Automatically adapt...

    'the start of this range:

    For Each cell In Sheets("Station Mapping").Range("A2:A140")

    Thanks and best regards

    Friday, August 18, 2017 9:35 AM
  • is there any way that the macro simply resets and starts again at the point it crashed?

    No, but you can skip the error and continue, see example below.

    You have to write code to list which PDF are skipped and furthermore more code to re-process that.

    Andreas.

    Sub Test()
      Dim i As Integer
      
      On Error GoTo Errorhandler
      For i = 1 To 10
        'Produce some 'Division by zero' errors:
        Debug.Print i, 10 / (i Mod 2)
      Next
      Exit Sub
      
    Errorhandler:
      Select Case Err.Number
        Case 11
          'Ignore 'Division by zero' error
          Debug.Print i, "error"
          Resume Next
        Case 18
          'User abort
        Case Else
          Debug.Print "Error      : " & Err.Number
          Debug.Print "Description: " & Err.Description
      End Select
    End Sub

    Friday, August 18, 2017 10:32 AM
  • Hi Andreas

    That would already help a lot. I have the code now as follows:

    Sub SaveAllPDFs()
    
    Dim cell As Range
    Dim Dashboard As Worksheet
    Dim counter As Long
    Dim location As String
    Dim PdfName As String, Title As String
    Dim i As Integer
      
      
    Application.ScreenUpdating = False
    
    Set Dashboard = Sheets("Station Dashboard")
       
       PdfName = location & Application.PathSeparator & Range("D1") & "-" & Range("D7") & ".pdf"
        On Error GoTo Errorhandler
        For Each cell In Sheets("Station Mapping").Range("A2:A140")
        If Not Range("J7") = 0 Then
          If Not IsEmpty(cell) Then
             With Dashboard
                .Range("D1").Value = cell.Value
                location = Range("K7")
                PdfName = location & Application.PathSeparator & Range("D1") & "-" & Range("D7") & ".pdf"
                .ExportAsFixedFormat _
                      Type:=xlTypePDF, _
                      Filename:=PdfName, _
                      Quality:=xlQualityStandard, _
                      IncludeDocProperties:=True, _
                      IgnorePrintAreas:=False, _
                      OpenAfterPublish:=False
             End With
          End If
        End If
       Next cell
       
       Set Dashboard = Nothing
      
    Errorhandler:
     Select Case Err.Number
        Case 11
          'Ignore 'Division by zero' error
          Debug.Print Range("D1"), "error"
          Resume Next
        Case 18
          'User abort
        Case Else
          Debug.Print "Error      : " & Err.Number
          Debug.Print "Description: " & Err.Description
      End Select
    End Sub

    Is the Case numbering associated to certain errors? (like case 11 for division by zero?) Because in that case I would need the Case for runtime error...?

    Joël

    Monday, August 21, 2017 1:01 PM
  • That would already help a lot. I have the code now as follows:

    Hi Joël,

    that code looks curious to me... which is the active sheet if you run that sub?

    Andreas.

    Tuesday, August 22, 2017 7:16 AM
  • Hi Andreas

    Sorry for the late response, the code is working fine now but I would like it to skip an iteration if a Value 0 is written in Cell J7 (decides whether a PDF needs to be created for the selection) during the loop through the drop down in D2.

    The code works in a way that is stops once it encounters a 0 but it does not skip and continue. Which is the right way to do it? It will not accept a Continue For or a Else GoTo

    The active Worksheet is calles "station dashboard".

    Thanks for your help

    Sub SaveAllPDFs()
    
    Dim cell As Range
    Dim Dashboard As Worksheet
    Dim location As String
    Dim PdfName As String, Title As String
      
      
    Application.ScreenUpdating = False
    
    Set Dashboard = Sheets("Station Dashboard")
    
        For Each cell In Sheets("Station Mapping").Range("A2:A140")
             If Range("J7").Value = 1 And Not IsEmpty(cell) Then
                With Dashboard
                       .Range("D1").Value = cell.Value
                       location = Range("K7")
                       PdfName = location & Application.PathSeparator & Range("D1") & "-" & Range("D7") & ".pdf"
                       .ExportAsFixedFormat _
                             Type:=xlTypePDF, _
                             Filename:=PdfName, _
                             Quality:=xlQualityStandard, _
                             IncludeDocProperties:=True, _
                             IgnorePrintAreas:=False, _
                             OpenAfterPublish:=False
                  End With
           Else Continue If
                  
         Next cell
    
    Set Dashboard = Nothing
    
    End Sub


    Monday, October 9, 2017 11:11 AM
  • Hello,

    You could use Exit Sub to end the process or use Exit For to end the iteration.

    For Each cell In Range("A2:A140")
    If Range("J7").Value = 0 Then
    Exit Sub ' Exit For
    ElseIf Range("J7").Value = 1 And Not IsEmpty(cell) Then
    
    End If
    Next

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Tuesday, October 10, 2017 6:53 AM
    Moderator
  • Thanks Celeste!

    The code works but jumps out completely once a "0" is encountered in cell J7... It creates the PDF (although it shouldn't) and the whole process stops.

    Is the End For placed in the wrong segment?

    Sub SaveAllPDFs()
    
    Dim cell As Range
    Dim Dashboard As Worksheet
    Dim location As String
    Dim PdfName As String, Title As String
      
      
    Application.ScreenUpdating = False
    
    Set Dashboard = Sheets("Station Dashboard")
    
    For Each cell In Sheets("Station Mapping").Range("A2:A140")
        If Range("J7").Value = 0 Then
            Exit For
                ElseIf Range("J7").Value = 1 And Not IsEmpty(cell) Then
                With Dashboard
                       .Range("D1").Value = cell.Value
                       location = Range("K7")
                       PdfName = location & Application.PathSeparator & Range("D1") & "-" & Range("D7") & ".pdf"
                       .ExportAsFixedFormat _
                             Type:=xlTypePDF, _
                             Filename:=PdfName, _
                             Quality:=xlQualityStandard, _
                             IncludeDocProperties:=True, _
                             IgnorePrintAreas:=False, _
                             OpenAfterPublish:=False
                End With
                End If
            Next
        
    Set Dashboard = Nothing
    
    End Sub
    Brgds, Joël

    Tuesday, October 10, 2017 9:46 AM
  • Hello,

    The code should work. It would exit the whole For block if Range("J7").Value = 0.

    If it would still export PDF after running, please add a breakpoint at  .ExportAsFixedFormat _
    to check if the breakpoint would be hitten. 

    Besides, you disable screen updating at the beginning, please remember enable it.

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, October 11, 2017 4:03 AM
    Moderator