LastRow = ActiveSheet.UsedRange.Rows.Count not givng correct value

[BobBlooms]

The ojective of this routine is to determine if any employees are overdue in their salary review date. The routine first goes out to an Acess DB, and grabs the records where the salary consideration date is < Now(). If LastRow count is > 1 (title line) a msgbox is activated. LastRow value keeps coming up 16 even when I delete the rows below the title row. I am truly lost on this.

Option Explicit

Sub Import_AccessData()
'   Set a reference to Microsoft ADO x.x library using Tools | Reference... in the VB-editor.

Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim stDB As String
Dim wsTitles As Worksheet
Dim wsSheet As Worksheet
Dim lnNumberOfField As Long, lnCount As Integer
Dim LastRow As Integer

Set wsSheet = ThisWorkbook.Worksheets("Sheet1")
Set wsTitles = ThisWorkbook.Worksheets("Sheet1")

stDB = ThisWorkbook.Path & "\" & "EOHHS.mdb"

wsSheet.Range("A1").CurrentRegion.Clear

cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & stDB & ";"

rst.Open "SELECT * FROM qSal_Con_Date_Has_Passed", cnt

lnNumberOfField = rst.Fields.Count

For lnCount = 0 To lnNumberOfField - 1
wsTitles.Cells(1, lnCount + 1).Value = rst.Fields(lnCount).Name
Next lnCount

wsSheet.Cells(2, 1).CopyFromRecordset rst

Set rst = Nothing
Set cnt = Nothing
   
Sheets("Sheet1").Select
Range("A1").Select

LastRow = ActiveSheet.UsedRange.Rows.Count
    
If LastRow > 1 Then
    MsgBox "Salary consideration action is required on " & LastRow & " employees"
Else: End If
      
End Sub