PDA

View Full Version : Solved: Delete emty rows.



Pinokkio
10-08-2009, 09:20 AM
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?

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

Data should not be ranked


Thanks in advance!

Pinokkio
10-10-2009, 12:17 PM
Finally found a macro for xl2007 for delete empty rows



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

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

jack nt
02-07-2010, 08:35 AM
The quoted codes should not be the above Sub "DelCellsUp", but is the following:

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

Frank123
03-18-2011, 10:46 PM
The code are really helpful to me.thanks for the sharing.

praloy sangm
06-30-2011, 07:28 PM
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
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

Regards,
Praloy

praloy sangm
06-30-2011, 07:29 PM
'Using For loop is more effective for this purpose
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

praloy sangm
07-02-2011, 01:51 AM
'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