How to speed up vba code that delete rows when column Q has blank cells

I have a sheet of almost 100000 rows & column A to Q I have a code that delete entire rows if column Q has blank cells.

I have tried this code on 4000 rows it is running in 3 minutes but when I take 100000 rows it just processing for hours.

I will be very great full if some help/guide me in speeding up this code.

The code is :

Sub DeleteBlank()
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual 
    
    Dim lo As ListObject
    set lo = sheets("BOM 6061").ListObjects(1)
    Sheets("BOM 6061").Activate
    
    lo.AutoFilter.ShowAllData
    lo.range.AutoFilter Field:=17, Criteria1:=""
    
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationAutomatic
    
    lo.DataBodyRange.SpecialCells(xlCellsTypeVisible).Delete
    
    Application.DisplayAlerts = True
    lo.AutoFilter.ShowAllData
End Sub

Remove Criteria Rows in an Excel Table Efficiently

• In a nutshell, if you don't sort the criteria column, deleting the rows may take 'forever'.
• The following will do just that, keeping the initial order of the remaining rows.

Option Explicit

Sub DeleteBlankRows()
    
    Const wsName As String = "BOM 6061"
    Const tblIndex As Variant = 1
    Const CriteriaColumnNumber As Long = 17
    Const Criteria As String = ""
    
    ' Reference the table.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim tbl As ListObject: Set tbl = ws.ListObjects(tblIndex)
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Remove any filters.
    If tbl.ShowAutoFilter Then
        If tbl.AutoFilter.FilterMode Then tbl.AutoFilter.ShowAllData
    Else
        tbl.ShowAutoFilter = True
    End If
    
    ' Add a helper column and write an ascending integer sequence to it.
    Dim lc As ListColumn: Set lc = tbl.ListColumns.Add
    lc.DataBodyRange.Value = _
        ws.Evaluate("ROW(1:" & lc.DataBodyRange.Rows.Count & ")")
    
    ' Sort the criteria column ascending.
    With tbl.Sort
        .SortFields.Clear
        .SortFields.Add2 tbl.ListColumns(CriteriaColumnNumber).Range, _
            Order:=xlAscending
        .Header = xlYes
        .Apply
    End With

    ' AutoFilter.
    tbl.Range.AutoFilter Field:=CriteriaColumnNumber, Criteria1:=Criteria
    
    ' Reference the filtered (visible) range.
    Dim svrg As Range
    On Error Resume Next
        Set svrg = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' Remove the filter.
    tbl.AutoFilter.ShowAllData
  
    ' Delete the referenced filtered (visible) range.
    If Not svrg Is Nothing Then svrg.Delete
    
    ' Sort the helper column ascending.
    With tbl.Sort
        .SortFields.Clear
        .SortFields.Add2 lc.Range, Order:=xlAscending
        .Header = xlYes
        .Apply
        .SortFields.Clear
    End With
    
    ' Delete the helper column.
    lc.Delete
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    ' Inform.
    MsgBox "Blanks deleted.", vbInformation
    
End Sub