Solved: Deleting Empty Rows

[Anomandaris]

Hi guys,


Any idea how to delete empty rows on a sheet? Random rows will be completely empty, and I need to get rid of these rows so it doesnt have any blank rows

thanks

[mdmackillop]

Sub Macro4()
Dim Rw As Long, i As Long
With ActiveSheet.UsedRange
'Find last row, delete blank rows
Rw = .Cells.Find(What:="*", after:=.Cells(1, 1), LookIn:= _
xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlPrevious, MatchCase:=False).Row
For i = Rw To 1 Step -1
If Application.CountA(.Rows(i)) = 0 Then
.Rows(i).EntireRow.Delete
End If
Next
End With
End Sub

[Krishna Kumar]

Hi,

Without loop

Sub kTest()
Dim r As Long, c As Long
Application.ScreenUpdating = 0
With ActiveSheet.UsedRange
r = .Rows.Count
c = .Columns.Count
End With
Columns(1).Insert
With Range("a1:a" & r)
.FormulaR1C1 = "=counta(rc[1]:rc[" & c & "])"
.Value = .Value
On Error Resume Next
.Replace What:="0", Replacement:="", LookAt:=xlWhole
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End With
Columns(1).Delete
Application.ScreenUpdating = 1
End Sub
HTH

[Anomandaris]

Thanks guys, it works well

[mdmackillop]

Hi Krishna,
Nice idea, but you need to check for the rightmost column. Try a test with data only in Column D
Regards
MD

[Mcygee]

Now the question I have is can you modify this script slightly so that it will delete the entire row based off a specific column being empty. I have rows that need deleted if a specific cell in that row is empty.

[mdmackillop]

Now the question I have is can you modify this script slightly so that it will delete the entire row based off a specific column being empty. I have rows that need deleted if a specific cell in that row is empty.
Range("J:J").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

[Krishna Kumar]

Hi Krishna,
Nice idea, but you need to check for the rightmost column. Try a test with data only in Column D
Regards
MD

Replace

c = .Columns.Count

with

c = Columns.Count

But I think my code should have been like this

Sub kTest()
Dim r As Long, c As Long
Application.ScreenUpdating = 0
With ActiveSheet.UsedRange
r = .Cells.Find(What:="*", after:=.Cells(1, 1), SearchDirection:=xlPrevious).Row
c = .Cells.Find(What:="*", after:=.Cells(1, 1), SearchDirection:=xlPrevious).Column
End With
Columns(1).Insert
With Range("a1:a" & r)
.FormulaR1C1 = "=counta(rc[1]:rc[" & c & "])"
.Value = .Value
On Error Resume Next
.Replace What:="0", Replacement:="", LookAt:=xlWhole
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End With
Columns(1).Delete
Application.ScreenUpdating = 1
End Sub

Kris

[Mcygee]

As usual, mdmackillop (http://www.vbaexpress.com/forum/member.php?u=87), you've been AWESOME! I don't know about the original poster, but this code works well for me and should probably be marked solved at this point.