One of the main culprits behind workbook bloat occurs when Excel thinks a sheet's used range is bigger than it actually is. This code will test each sheet of the active workbook and either fix the problem automatically or simply alert you to it. It can be adapted for automation as well, but be aware that the code as it appears below ignores cell formatting when determining the number of rows in use. It also assumes your used range starts in the first row, but if that's not true it will not delete rows mistakenly as a result. This code could also be adapted for analyzing the used range's columns.

You can also test the used range row and column counts for the active sheet (or any sheet) through the VBE by typing "?activesheet.usedrange.rows.count" or "?activesheet.usedrange.columns.count". Control-G will bring up the immediate window from the VBE (and Alt-F11 brings up the VBE).


Option Explicit

Public Sub CheckUsedRangesForActiveWB()

    Dim ws As Worksheet, LastRow&, tempStr$, PromptBeforeDeletingUnusedRows As Boolean
    If (MsgBox("Prompt before deleting unused rows?", vbYesNo, "") = vbYes) Then _
        PromptBeforeDeletingUnusedRows = True
   
    For Each ws In ActiveWorkbook.Sheets
        With ws
            LastRow = GetLastRow(.Name)
            If (.UsedRange.Rows.Count > LastRow) Then
                If PromptBeforeDeletingUnusedRows Then
                    If (MsgBox("Excel thinks the used range for sheet " & _
                            .Name & " is " & .UsedRange.Rows.Count & _
                            " rows tall, but only " & LastRow & " rows are being used." & Chr(10) & _
                            "Deleting all rows after " & LastRow & " would solve the problem." & Chr(10) & _
                            "Do you want to do that now?", vbYesNo, "") = vbYes) Then
                        tempStr = LastRow + 1 & ":" & .Rows.Count
                        .Rows(tempStr).Delete
                    End If
                Else
                    tempStr = LastRow + 1 & ":" & .Rows.Count
                    .Rows(tempStr).Delete
                End If
            End If
        End With
    Next
   
End Sub

Private Function GetLastRow&(WSName$)
   
    Dim j&, tempInt&
    For j = 1 To ActiveSheet.Columns.Count
        tempInt = ActiveWorkbook.Sheets(WSName).Cells(ActiveSheet.Rows.Count, j).End(xlUp).Row
        If (tempInt > GetLastRow) Then GetLastRow = tempInt
    Next

End Function