Sub DeleteEmptyRows()
Dim LastRow As Long, LastColumn As Long, r As Long
intResponse = MsgBox("This will delete all empty rows and columns in this worksheet.", vbOKCancel, "Delete Empty Rows/Columns")
If intResponse = vbOK Then
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
LastRow = ActiveSheet.UsedRange.Rows.count
LastColumn = ActiveSheet.UsedRange.Columns.count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
For r = LastColumn To 1 Step -1
If Application.CountA(Columns(r)) = 0 Then Columns(r).Delete
Next r
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End If
Application.ScreenUpdating = True
End Sub