removing large numbers of empty rows

[kerrysr]

I have a large spreadsheet with a large number of empty rows. It would take forever to select each row and delete it.

I tried ASAP utilities but it does not remove the empty rows.

Any suggestions?

Thks

 

[jdee]

I just tried asap utilities re: deleting empty rows and it worked for me. Here is what I used:

Select - Conditional row and column select, hide or delete, perform action in (choose your data), search options - completely empty rows, what to do when found rows/columns (radio button) choose, click start. This deleted my empty rows.

 

[BrianB]

Here is a macro :-

Sub DeleteEmptyRows()
    Dim ws As Worksheet
    Dim MyDeleteRange As Range ' macro sets range for deletion
    Dim DeletedRows As Long
    Dim MyCell As Range        ' single cell added to MyDeleteRange
    Dim LastRow As Long
    Dim Foundcell As Object
    '----------------------------------------------------------------
    Application.Calculation = xlCalculationManual
    DeletedRows = 0
    Set ws = ActiveSheet
    '- find last row
    Set Foundcell = ActiveSheet.Cells.Find(what:="*", _
        after:=Range("IV65536"), searchdirection:=xlPrevious)
    LastRow = Foundcell.Row
    '----------------------------------------------------------------
    '- check cells
    For r = 1 To LastRow
        If Application.WorksheetFunction.CountA(ws.Rows(r).EntireRow) = 0 Then
            DeletedRows = DeletedRows + 1
            Set MyCell = ws.Cells(r, "A")
            If MyDeleteRange Is Nothing Then
               '- first matching cell
               Set MyDeleteRange = MyCell
            Else
               '- add subsequent matching cells to the range
               Set MyDeleteRange = Union(MyDeleteRange, MyCell)
            End If
        End If
    Next
    '----------------------------------------------------------------
    '- delete all rows in the range
    MyDeleteRange.EntireRow.Delete
    Application.Calculation = xlCalculationAutomatic
    MsgBox ("Deleted " & DeletedRows & " rows.")
End Sub