CODEWITHSUNDEEP
excelvbapdf-generationinfinite-loop
AshNev
AshNev

Reputation: 3

Convert Excel Sheet to PDFs, Infinite Loop Error

I have used bits and pieces of code on forums to create a macro that exports PDF's from a single sheet in excel. Each PDF contains the header and all relevant rows to the employee (all rows with employee ID). When I run it all goes well and the pdfs are correct, however the macro never stops running.

I believe I have created an infinite loop and am not sure how to correct it.

It also creates a PDF just containing the header that is not necessary.

Sub PracticeToPDF()

Dim ws As Worksheet
Dim ws_unique As Worksheet
Dim DataRange As Range
Dim iLastRow As Long
Dim iLastRow_unique As Long
Dim UniqueRng As Range
Dim Cell As Range
Dim LastRow As Long
Dim LastColumn As Long

Application.ScreenUpdating = False

'Note that the macro will save the pdf files in this active directory so you should save in an appropriate folder
DirectoryLocation = ActiveWorkbook.Path

Set ws = Worksheets("BootVSPayroll") 'Amend to reflect the sheet you wish to work with
Set ws_unique = Worksheets("BootVSPayroll") 'Amend to reflect the sheet you wish to work with

'Find the last row in each worksheet
iLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
iLastRow_unique = ws_unique.Cells(Rows.Count, "A").End(xlUp).Row


With ws
    'I've set my range to reflect my headers which are fixed for this report
    Set DataRange = ws.Range("$A$1:$K$1" & iLastRow)

    'autofilter field is 4 as I want to print based on the practice value in column D
    DataRange.AutoFilter Field:=1

    Set UniqueRng = ws_unique.Range("A1:A20" & iLastRow_unique)
    For Each Cell In UniqueRng
        DataRange.AutoFilter Field:=1, Criteria1:=Cell

    Name = DirectoryLocation & "\" & Cell.Value & " BOOT Report" & ".pdf"

    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=False

    Next Cell

End With
With ws
     .Protect Userinterfaceonly:=True, _
     DrawingObjects:=False, Contents:=True, Scenarios:= _
    True, AllowFormattingColumns:=True, AllowFormattingRows:=True
     .EnableOutlining = True
     .EnableAutoFilter = True
     If .FilterMode Then
        .ShowAllData
     End If
 End With
Application.ScreenUpdating = True

End Sub

Upvotes: 0

Views: 108

Answers (1)

George
George

Reputation: 158

Did you perhaps mean for:

Set DataRange = ws.Range("$A$1:$K$1" & iLastRow)
...
Set UniqueRng = ws_unique.Range("A1:A20" & iLastRow_unique)

to instead be:

Set DataRange = ws.Range("$A$1:$K$" & iLastRow)
...
Set UniqueRng = ws_unique.Range("A1:A" & iLastRow_unique)

?

If, for example, (taken from ws_unique) your last used row, iLastRow_unique equals 200, then "A1:A20" & iLastRow_unique is equivalent to "A1:A20200" -- which may be a lot more rows that you intended to loop through, I think.

Upvotes: 1

Related Questions