I am using the code below to delete blank rows from up to 50,000 rows of
data. The data can be between 20,000 and 50,000 rows. It works fine however
it takes about 10 mins to complete. Any suggestions on improved code that
could complete the task quicker?

Sub Delete_Rows_Empty()
Application.Calculation = xlManual
Application.ScreenUpdating = False
Dim Rng As Range, ix As Long
Dim csht As Long
Set Rng = Range("p2:p50000")
For ix = Rng.Count To 1 Step -1
If Trim(Application.Substitute(Rng.Item(ix).Text, _
Chr(160), Chr(32))) = "" Then
Rng.Item(ix).EntireRow.Delete
End If
Next
done:
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub