delete empty rows

[Imthiaz]

Can someone help with VBA/macro to delete empty rows in a range (ie., if all the cells in a row is empty)

[Jorgen]

Hi,
Here is an old vba-macro that pops a question and asks how many cells besides the single column selected the macro should check.

Then it runs, and shows progress in the status line.

Sub DeleteEmptyRow()       '97-10-29 Jörgen Möller
' Takes a single-column-selection row by row from the top, and checks
' if the selected cell and adjoining cells are empty

Dim Ruta3 As Object, AntRut As Integer, i As Integer, Tomma As Integer
Dim AntRader As Integer, Startrad As Integer
Dim KlarProc As Single
Dim StartTid As Date, Kvartid As Date

    If MsgBox("Do you really want to erase all empty rows (Checks selected cell& x adjoining to the right)? ", _
               vbYesNo, "Delete Empty Rows") <> vbYes Then Exit Sub
    If Selection.Columns.Count > 1 Then MsgBox "You have selected more than one column, doesn't work": Exit Sub
    AntRut = Val(InputBox("Number of cells to the right (and including) selected cell to check for emptiness?", "Cells to Check", 5))
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Startrad = Selection.Row()
    StartTid = Now()
    AntRader = Selection.Rows.Count
      For Each Ruta3 In Selection()
        KlarProc = (Ruta3.Row - Startrad) / AntRader
        If Ruta3.Row Mod 100 = 0 Then Kvartid = StartTid - Now() + (Now() - StartTid) / KlarProc
        Application.StatusBar = "Finished with: " & Int(100 * KlarProc) & " percent. Estimated finish in: " & Kvartid

       Tomma = 0
       For i = 0 To AntRut - 1
         If IsEmpty(Ruta3.Offset(0, i)) Then Tomma = Tomma + 1
       Next i
       If Tomma = AntRut Then Ruta3.EntireRow.Delete
      Next
    Application.Calculation = xlAutomatic
    Application.StatusBar = False
    Beep
End Sub

Good luck,
Jörgen