Solved: Delete emty rows.

[Pinokkio]

I have several macros used to remove empty rows. But none will work?

I have data in column A (to cell A8000) with blank lines(random) at some distance.


Is there a macro for Excel 2007?


This macro deletes a few lines every time you start the macro?

[VBA]Sub DeleteBlankRows()
Dim Rw As Long, RwCnt As Long, Rng As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

On Error GoTo Exits:

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row()))
End If
RwCnt = 0
For Rw = Rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Rng.Rows(Rw).EntireRow) = 0 Then
Rng.Rows(Rw).EntireRow.Delete
RwCnt = RwCnt + 1
End If
Next Rw

Exits:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub[/VBA]

Data should not be ranked


Thanks in advance!

[Pinokkio]

Finally found a macro for xl2007 for delete empty rows



http://www.mvps.org/dmcritchie/excel/delempty.htm#Rows

[vba]Sub DelCellsUp()
'David McRitchie 1998-07-17 revised 2002-01-17
' http://www.mvps.org/dmcritchie/excel/delempty.htm
'Delete Empty Cells and cells with only spaces in range
' and move cells up from below even if not in range
'Will process single range of one or more columns
'Will not remove cells with formulas
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'pre XL97 xlManual
Dim rng As Range, ix As Long
Set rng = Intersect(Selection, ActiveSheet.UsedRange)
If rng Is Nothing Then
MsgBox "nothing in Intersected range to be checked/removed"
GoTo done
End If
For ix = rng.Count To 1 Step -1 'CHR(160) is non-breaking space
If Len(Trim(Replace(rng.Item(ix).Formula, Chr(160), ""))) _
= 0 Then rng.Item(ix).Delete (xlUp)
Next
done:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub[/vba]

[jack nt]

The quoted codes should not be the above Sub "DelCellsUp", but is the following:

[vba]Sub DelEmptyRows()
Dim i As Long, iLimit As Long
iLimit = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'pre XL97 xlManual
For i = iLimit To 1 Step -1
If Application.CountA(Cells(i, 1).EntireRow) = 0 Then
Cells(i, 1).EntireRow.Delete
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
iLimit = ActiveSheet.UsedRange.Rows.Count 'attempt to fix lastcell
ActiveWorkbook.Save
End Sub[/vba]

[Frank123]

The code are really helpful to me.thanks for the sharing.

[praloy sangm]

Hi Pinokkio,

We do have easy way to approach your need. Remember that even " " (one space) in the cell is also not a blank but considered a character and in that case you need to use your logic in different way. One of the easiest way is to use the following codes:

'Using For loop is more effective for this purpose
[VBA]Sub Deletemptyrows()
Dim i As Integer ' if data exceeds 45000 then we could declare as long or double
'Assuming that you have data upto 5000 and even column 1 is empty else
For i = 1 To 5000
If Cells(i, 1).Value = "" Then
Cells(i, 1).EntireRow.Select
Selection.Delete Shift:=xlUp
End If
Next i
End Sub
[/VBA]
Regards,
Praloy

[praloy sangm]

'Using For loop is more effective for this purpose
[VBA]Sub Deletemptyrows()
Dim i As Integer ' if data exceeds 45000 then we could declare as long or double
'Assuming that you have data upto 5000 and even column 1 is empty else
For i = 1 To 5000
If Cells(i, 1).Value = "" Then
Cells(i, 1).EntireRow.Select
Selection.Delete Shift:=xlUp
End If
Next i
End Sub[/VBA]

[praloy sangm]

[VBA]

'Using For loop is more effective for this purpose
Sub Deletemptyrows()
Dim i As Integer ' if data exceeds 45000 then we could declare i as long or double
'Assuming that you have data upto 5000 and even column 1 is empty else and you want to delete based on the empty cells in column 1:

For i = 1 To 5000
If Cells(i, 1).Value = "" Then
Cells(i, 1).EntireRow.Select
Selection.Delete Shift:=xlUp
End If
Next i
End Sub

[/VBA]