Delete empty rows

[tqm1]

Dear Expers

How to delete empty rows between First Filled Row and Last Filled Row.

Please help

[mperrah]

Hello,
Not sure if this helps, but it will shrink the file size of the entire document removing things unused and completing all calculations before saving.
In the VB editor (alt+F11) add a module and paste the code below.
Hit alt+F8 and select shrinkfilesize to run the macro. I got this help from this forum.
Glad to share.
Mark

Option Explicit

Sub ShrinkFileSize()
Dim j               As Long
    Dim k               As Long
    Dim lastrow         As Long
    Dim LastCol         As Long
    Dim ColFormula      As Range
    Dim RowFormula      As Range
    Dim ColValue        As Range
    Dim RowValue        As Range
    Dim Shp             As Shape
    Dim ws              As Worksheet
Application.ScreenUpdating = False
    Application.DisplayAlerts = False
On Error Resume Next
For Each ws In Worksheets
    With ws
        On Error Resume Next
        Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
        Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
        Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
        Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
        On Error GoTo 0
        If ColFormula Is Nothing Then
            LastCol = 0
        Else
            LastCol = ColFormula.Column
        End If
        If Not ColValue Is Nothing Then
            LastCol = Application.WorksheetFunction.Max(LastCol, ColValue.Column)
        End If
        If RowFormula Is Nothing Then
            lastrow = 0
        Else
            lastrow = RowFormula.Row
        End If
        If Not RowValue Is Nothing Then
            lastrow = Application.WorksheetFunction.Max(lastrow, RowValue.Row)
        End If
        For Each Shp In .Shapes
            j = 0
            k = 0
            On Error Resume Next
            j = Shp.TopLeftCell.Row
            k = Shp.TopLeftCell.Column
            On Error GoTo 0
            If j > 0 And k > 0 Then
                Do Until .Cells(j, k).Top > Shp.Top + Shp.Height
                    j = j + 1
                Loop
                If j > lastrow Then
                    lastrow = j
                End If
                Do Until .Cells(j, k).Left > Shp.Left + Shp.Width
                    k = k + 1
                Loop
                If k > LastCol Then
                    LastCol = k
                End If
            End If
        Next
        .Range(Cells(1, LastCol + 1).Address & ":IV65536").Delete
        .Range(Cells(lastrow + 1, 1).Address & ":IV65536").Delete
    End With
    Next
Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

[Bob Phillips]

Just filter the column on blanks and then delete the visible rows.

[jammer6_9]

This code will delete empty rows in an active sheet.

Sub DeleteEmptyRowsInSheet()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim lastrow As Long, r As Long
lastrow = ActiveSheet.UsedRange.Rows.Count
For r = lastrow To 2 Step -1
    If UCase(Cells(r, 1).Value) = "" Then
        With Rows(r)
            .Delete
        End With
    End If
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub