Deleting Blank Rows using VBA

[SHAWTY721]

I have a spreadsheet that I need to delete the blank rows starting at a specific column but the code that I have used isn't deleting the necessary rows. Here is the VBA code that I am using.

Private Sub Worksheet_Activate()
'Deletes the entire row within the selection if the ENTIRE row contains no data.

'Use Long in case they have over 32,767 rows selected.
Dim i As Long

'Turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

'Work backwards because we are deleting rows.
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True

End With

End Sub

I want the rows under the column headings starting at row 15 to be deleted if no data is present and delete the rows that don't contain any meaningful data. The rows that just list zeroes for all the columns.

[Bob Phillips]

rivate Sub Worksheet_Activate()
'Deletes the entire row within the selection if the ENTIRE row contains no data.

'Use Long in case they have over 32,767 rows selected.
Dim i As Long

'Turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

'Work backwards because we are deleting rows.
With Selection
For i = .Rows.Count To 1 Step -1
If Application.CountA(.Rows(i)) = Application.CountIf(.Rows(i), 0) Then
.Rows(i).EntireRow.Delete
End If
Next i
End With

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True

End With

End Sub