Can I create a macro to identify and delete blank rows in a range?
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
"JMB" wrote in message
...
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
"carlsondj" wrote:
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!
|