Can I create a macro to identify and delete blank rows in a range?

[carlsondj]

I have a report that a customer sends me via e-mail. It is a text file and
so to get it to the point of use I have to manually delete all of the blank
rows. Can I create a macro to identify and delete all of the blank rows
within this range of data. The files can be up to 10,000 lines of data and
every other or every two rows need to be deleted. It takes forever!

 

[Chandra]

Hi

You can write a macro for that.

Just write the code on Workbook_Open event of MS Excel.

When u try to open the file, the blank rows are deleted and u get file
only with data

best Regards,
Chandra
http://groups.msn.com/SQLResource/
http://chanduas.blogspot.com/

 

[JMB]

you could use the following macro. select/highlight the column you want and
it will delete the entire row. ensure you back up your spreadsheet.

Sub DeleteBlanks()
Dim Range1 As Range
Dim x As Object

If Selection.Columns.Count > 1 Then _
Exit Sub

For Each x In Selection
If x.Value = "" Then
If Range1 Is Nothing Then
Set Range1 = x
Else: Set Range1 = Union(Range1, x)
End If
End If
Next x

Range1.EntireRow.Delete

End Sub


you could also select the first column of your table (cell a1:a10000 for
example) turn on the autofilter (data/filter/autofilter). click the drop
down box on column a. select "blanks". this will hide all nonblank data in
your range. select the filtered range (row numbers are colored blue). click
edit/delete row. select show all from the drop down box on column a. then
turn off the autofilter (data/filter/autofilter).

 

[JMB]

this would be a little better. you could select the entire column you want
evaluated with one click on the column header.

Sub DeleteBlanks()
Dim Range1 As Range
Dim Isect As Range

Dim x As Object

If Selection.Columns.Count > 1 Then _
Exit Sub

Set Isect = Intersect(Selection.Parent.UsedRange, Selection)

For Each x In Isect
If x.Value = "" Then
If Range1 Is Nothing Then
Set Range1 = x
Else: Set Range1 = Union(Range1, x)
End If
End If
Next x

Range1.EntireRow.Delete

End Sub

 

[davidm]

Alternately,


Sub deleteBlankRws()
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).Delete
End Sub

 

[William Benson]

I like to clean up the data file before importing to preserve room for valid
rows in Excel and because deleting rows in Excel messes with the end row
until the workbook is saved. The below is offered if carlsondj wants
another approach, I am not saying it is better..

Sub cleanfile()
'Code to read in data lines and write non-blank rows to a new file
'Preserves the old file (additional lines of code could be written to
'Kill old and rename new to the old

Dim TheGoodFile As String
Dim FileNumIn As Long
Dim FileNumOut As Long
Dim aLine
Dim TheBadFile As String

TheBadFile = InputBox("File to import?", , _
"C:\documents and settings\" & Environ("username") & _
"\Desktop\TestTxt.txt")

TheGoodFile = Left(TheBadFile, _
Len(TheBadFile) - 4) & "_clean" & Right(TheBadFile, 3)

FileNumIn = FreeFile

Err.Clear
On Error Resume Next
Open TheBadFile For Input Lock Read Write As #FileNumIn
If Err.Number = 76 Then
MsgBox "Invalid file name - or path - please start over"
Exit Sub
End If

FileNumOut = FreeFile
Err.Clear
Open TheGoodFile For Output Lock Write As #FileNumOut
If Err.Number <> 0 Then
MsgBox "Cannot lock the file:" & _
Chr(13) & " " & TheGoodFile & Chr(13) & Chr(13) & _
"Aborting. Try again when that file is free to be over-written"
Exit Sub
End If
While Not EOF(FileNumIn)
Line Input #FileNumIn, aLine
'Testing for blank rolw. The below conditions assume the file is a
normal looking
'data file, where there is unlikely to be 1 or 2-char lines
'unless they are carriage returns, tabs, or newline chars
If Len(Trim(aLine)) <= 2 _
And (Trim(aLine) = "" Or _
InStr(Trim(aLine), Chr(13)) <> 0 Or _
InStr(Trim(aLine), Chr(10)) <> 0 Or _
InStr(Trim(aLine), vbNewLine) <> 0 Or _
Trim(aLine) = vbTab) Then
'do nothing... skip the line
Else
Print #FileNumOut, aLine
End If
Wend
Close FileNumIn
Close FileNumOut
End Sub

 

[William Benson]

Your code does not work, it deletes every line

 

[JMB]

I like that. I've never worked with SpecialCells before. It worked okay on
my machine. Would just like to point out, if he has a table w/multiple
columns and needs to keep his rows together, he'll need to delete the entire
row.

Sub deleteBlankRws()
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub