PDA

View Full Version : [SOLVED] Delete empty rows



tqm1
06-05-2007, 11:48 PM
Dear Expers

How to delete empty rows between First Filled Row and Last Filled Row.

Please help

mperrah
06-06-2007, 12:41 AM
Hello,
Not sure if this helps, but it will shrink the file size of the entire document removing things unused and completing all calculations before saving.
In the VB editor (alt+F11) add a module and paste the code below.
Hit alt+F8 and select shrinkfilesize to run the macro. I got this help from this forum.
Glad to share.
Mark

Option Explicit

Sub ShrinkFileSize()
Dim j As Long
Dim k As Long
Dim lastrow As Long
Dim LastCol As Long
Dim ColFormula As Range
Dim RowFormula As Range
Dim ColValue As Range
Dim RowValue As Range
Dim Shp As Shape
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
For Each ws In Worksheets
With ws
On Error Resume Next
Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
On Error GoTo 0
If ColFormula Is Nothing Then
LastCol = 0
Else
LastCol = ColFormula.Column
End If
If Not ColValue Is Nothing Then
LastCol = Application.WorksheetFunction.Max(LastCol, ColValue.Column)
End If
If RowFormula Is Nothing Then
lastrow = 0
Else
lastrow = RowFormula.Row
End If
If Not RowValue Is Nothing Then
lastrow = Application.WorksheetFunction.Max(lastrow, RowValue.Row)
End If
For Each Shp In .Shapes
j = 0
k = 0
On Error Resume Next
j = Shp.TopLeftCell.Row
k = Shp.TopLeftCell.Column
On Error GoTo 0
If j > 0 And k > 0 Then
Do Until .Cells(j, k).Top > Shp.Top + Shp.Height
j = j + 1
Loop
If j > lastrow Then
lastrow = j
End If
Do Until .Cells(j, k).Left > Shp.Left + Shp.Width
k = k + 1
Loop
If k > LastCol Then
LastCol = k
End If
End If
Next
.Range(Cells(1, LastCol + 1).Address & ":IV65536").Delete
.Range(Cells(lastrow + 1, 1).Address & ":IV65536").Delete
End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Bob Phillips
06-06-2007, 01:41 AM
Just filter the column on blanks and then delete the visible rows.

jammer6_9
06-06-2007, 02:13 AM
This code will delete empty rows in an active sheet.



Sub DeleteEmptyRowsInSheet()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim lastrow As Long, r As Long
lastrow = ActiveSheet.UsedRange.Rows.Count
For r = lastrow To 2 Step -1
If UCase(Cells(r, 1).Value) = "" Then
With Rows(r)
.Delete
End With
End If
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub