Loop with one data row

[adam]

The following code works fine if I have a list of data in sheet employees. It even works if I have a single data row in sheet employees. However, the macro does not stop running if I have one data row.

How could I make the code to run and stop even with one data row.

Any help would be kindly appreciated.

Code: Select all

Sub Generate()
Dim IDCell As Range
Dim strID As String
Dim mssgResponse As String
Dim rng As Range

On Error Resume Next
MkDir ThisWorkbook.Path & "\Employee Awards"

    strID = Sheets("employees").Range("B5").End(xlDown).Address

    For Each IDCell In Sheets("employees").Range("$B$5:" & strID)
        Sheets("awards").Range("B5") = IDCell
        
        Set rng = Sheets("awards").Range("F3:F39")
        
        rng.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
        ThisWorkbook.Path & "\Employee Awards\" & Sheets("employees").Range("B6").Value & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, _
        OpenAfterPublish:=False

    Next IDCell

 MsgBox "finished successfully.", vbInformation, "Management System"
 
End Sub

[HansV]

Change

Code: Select all

    strID = Sheets("employees").Range("B5").End(xlDown).Address

to

Code: Select all

    strID = Sheets("employees").Range("B" & Sheets("employees").Rows.Count).End(xlUp).Address

[adam]

Thankyou Hans. It worked fine.