Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Macro to delete blank lines

Status
Not open for further replies.

louismx

Technical User
May 29, 2004
5
0
0
IE
Hello

I have mutiple sheets of data and all have at least the first line empty but some have two blank lines.
How do I include in my macro a command to delete these blank lines.
 
Do you have a single column where you can reliably say that if the cell within that column is blank then the row can be deleted? If so then a non-vba route would be to select that column, do Edit / Go To / Special / Blank Cells, then do Edit / Delete / Entire Row.

If you prefer VBA then perhaps some of the following may help:-
Code:
Sub DelBlanks()

On Error Resume Next     ' In case there are no blanks
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
End Sub
or
Code:
Sub DeleteReallyBlankRows()
'Chip Pearson
'Will delete all rows that are entirely blank
Dim r As Long
Dim c As Range
Dim n As Long
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Selection.Rows.Count > 1 Then
    Set Rng = Selection
Else
    Set Rng = ActiveSheet.UsedRange.Rows
End If
n = 0
For r = Rng.Rows.Count To 1 Step -1
    If Application.WorksheetFunction.CountA(Rng.Rows(r).EntireRow) = 0 Then
        Rng.Rows(r).EntireRow.Delete
        n = n + 1
    End If
Next r
EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
or
Code:
Sub DeleteEmptyRows()
'John Walkenbach
'Will delete all rows that are entirely blank
    LastRow = ActiveSheet.UsedRange.Row - 1 + _
        ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For r = LastRow To 1 Step -1
        If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
    Next r
End Sub
Regards
Ken..............

----------------------------------------------------------------------------
[peace]It's easier to beg forgiveness than ask permission[2thumbsup]

----------------------------------------------------------------------------
 
Hi
This is mainly an academic exercise for my own piece of mind but I wondered if there was a way to do this without looping through every row, which could be a pain in really big spreadsheets.

What I really wanted to do was traverse an array backwards! What I mean is go from
UBound to LBound
rather than the other way round. As I couldn't workout how I created the function I use here to manipulate the range string.

As I say, this is only a bit of fun but it should be quicker when dealing with large data sets.
Note: due to the use of the Split function this will only work with xl2k upwards.

Code:
Sub DeleteBlankRows()
'Delete empty Rows without
'the need to loop through all rows

Dim rng As Range
Dim sRng As String
Dim lRowCnt As Long
Dim vArr As Variant
Dim lRow As Long
Dim r As Long

On Error GoTo Handler
Application.ScreenUpdating = False

'get last row containing data and set range
'making initial assumption that empty cells in colA are empty rows
lRow = Cells.Find("*", , , , xlByRows, xlPrevious).Row
Set rng = Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks)

'turn range aroung to work with cells in reverse order
'using custom function
sRng = ReverseRange(rng.Address(False, False))

'manipulate range string to use as array
vArr = Split(sRng, ",")
For lRowCnt = LBound(vArr) To UBound(vArr)
    'Allow for multiple consecutive rows, some of which might not be empty
    'Still need to work in reverse here
    For r = Range(vArr(lRowCnt)).SpecialCells(xlCellTypeLastCell).Row _
        To Range(vArr(lRowCnt)).Cells(1, 1).Row Step -1
            'Delete offending rows!!!!
            If WorksheetFunction.CountA(Rows(r)) = 0 Then
                Rows(r).EntireRow.Delete
            End If
    Next r
Next lRowCnt

'Clean up
Clean_Exit:
Set rng = Nothing
Application.ScreenUpdating = True
Exit Sub

Handler:
'No balnk cells in Col A ?
If Err.Description = "No cells were found." Then
    MsgBox Err.Description
    Resume Clean_Exit
End If
MsgBox Err.Description & "  " & Err.Number

End Sub

And the function to reverse the range string...

Code:
Function ReverseRange(sRng As String) As String
'Reverses the order of cells in a range string
'to enable manipulation from last cell to first cell
Dim iEnd As Integer
Dim sTemp1 As String

    iEnd = InStrRev(sRng, ",", Len(sRng) - 1)
    sTemp1 = sRng
    
    Do Until iEnd = 0
        ReverseRange = ReverseRange & Right(sTemp1, Len(sTemp1) - iEnd) & ","
        sTemp1 = Left(sRng, Len(sRng) - Len(ReverseRange))
        iEnd = InStrRev(sTemp1, ",", Len(sTemp1) - 1)
    Loop
ReverseRange = ReverseRange & Right(sTemp1, Len(sTemp1) - iEnd)
End Function

;-)


If a man says something and there are no women there to hear him, is he still wrong? [ponder]
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244
 
A better version without the need for the function to manipulate the string. A flash of inspiration (1:45 am!) but still just a bit of fun!

Code:
Sub DeleteBlankRows_V2()
'Delete empty Rows without
'the need to loop through all rows

Dim rng As Range
Dim lRowCnt As Long
Dim vArr As Variant
Dim lRow As Long
Dim r As Long

On Error GoTo Handler
Application.ScreenUpdating = False

'get last row containing data and set range
'making initial assumption that empty cells in colA are empty rows
lRow = Cells.Find("*", , , , xlByRows, xlPrevious).Row
Set rng = Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks)

'manipulate range string to use as array
vArr = Split(rng.Address(False, False), ",")
For lRowCnt = UBound(vArr) To 0 Step -1
    'Allow for multiple consecutive rows, some of which might not be empty
    'Still need to work in reverse here
    For r = Range(vArr(lRowCnt)).End(xlDown).Row - 1 _
        To Range(vArr(lRowCnt)).Cells(1, 1).Row Step -1
            'Delete offending rows!!!!
            If WorksheetFunction.CountA(Rows(r)) = 0 Then
                Rows(r).EntireRow.Delete
            End If
    Next r
Next lRowCnt

'Clean up
Clean_Exit:
Set rng = Nothing
Application.ScreenUpdating = True
Exit Sub

Handler:
'No blank cells in Col A ?
If Err.Description = "No cells were found." Then
    MsgBox Err.Description
    Resume Clean_Exit
End If
MsgBox Err.Description & "  " & Err.Number

End Sub

;-)

If a man says something and there are no women there to hear him, is he still wrong? [ponder]
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top