Delete empty rows

[maba]

I need to find a solution for simple broplem:

I have huge imported sheet (62000 rows) where I have to remove empt
rows using value from column A.
This code is working when I give smaller range like A1:A2000 put no
when I using in area method A:A

Sub del_emtyrows()

Application.ScreenUpdating = False
Columns("A:A").Select ' this will work when I use Range A1:A2000
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Application.ScreenUpdating = True
End Sub

When macro is over the sheet is totally blank!
I have data in colums A to D, and there is empty rows like 1 to
between data.

Mark

 

[Norman Jones]

Hi Maba,

You are hittng up against a known problem (feature) related to the
SpecialCells method: If, in this case, there are more than 8192
non-contiguous blank cell areas in column A, the SpecialCells method will
return an area comprising the entire base range (" Columns("A:A")") and, in
consequence *all* rows will be deleted, leaving you with a blank worksheet.

For your information, see the MSKB artiicle # 832293

http://support.microsoft.com/default.aspx?scid=kb;en-us;832293

For this reason, care should always be exercised if there is a possibility
of non-contiguous areas exceeding the 8192 threshold. Certainly, I would
endeavour to avoid entire column base ranges in such circumstances.

Incidentally, whilst VBA reacts silently in these circumstances, if a
comparable range were to be selected in Excel, an error message would result
and any action would be cancelled.

 

[Dnereb]

Code
-------------------

Application.ScreenUpdating = False
Columns("A:A").Select ' this will work when I use Range A1:A2000
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Application.ScreenUpdating = True
End Su -------------------

I would use a diffrent approach like:


Code
-------------------
Sub DeleteEmptyRows()

Dim Col As Long, Rw As Long ' Longs to count the columns and rows


Dim I As Long, J As Long ' counters
Dim RowMAX As Long
Dim ColumnMAX As Long
Dim RowEmpty As Boolean ' flag to indicate if row is still empty

RowMAX = ActiveSheet.UsedRange.Rows.Count ' set the limits to search
ColumnMAX = ActiveSheet.UsedRange.Columns.Count ' to speed this up

RowEmpty = True
' these two loops run from the last row to the first to prevent skipping a row after deleting a row
' Yeah think about it
For I = RowMAX To 1 Step -1
For J = ColumnMAX To 1 Step -1
If Len(ActiveSheet.Cells(I, J).Text) > 0 Then 'detect data
RowEmpty = False 'set fleg to false
Exit For ' quit loop because ther's no need to continue
End If
Next
If RowEmpty Then ' No data was found in this row.
ActiveSheet.Rows(I).Delete ' Hint: this will move up all rows below this one thus the current row was row I + 1
End If
RowEmpty = True ' reset the flag for the next row
Next

End Sub

-------------------
This is a better way of coding so please study it. for one thing it doe
not matter how large the field of data is. BTW No refreshing occurs thi
way too

It isn't exactly what you've asked for but it only deletes rows withou
any visual dat

 

[maba]

Thank's for quick answers.

Dnereb, I tired your code and its working but not exactly what I wanted
cause I have data also columns B, C, D and A is empty. What I wanted to
delete all rows where is empty cell in column A. Using your code it
will remove totally empty rows but leaves rows where cell column A is
empty and there is data columns B.

Norman, I got solution from your answer and made next macro:

Sub delete_EmptyRows()

Range("A1:A8000").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete

For I = 1 To 7

Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Range("A1:A8000").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Next I

End Sub

Its working but slowly. Here is macro where I am using this code:

Sub laitereksiivous()

ChDir "C:\Documents and Settings\Rotator\Omat tiedostot\Unix"

Dim sFilename As String

' Showing director window
omaTiedosto = Application.GetOpenFilename("Text files,*.*", , "Select a
file")

If omaTiedosto = "False" Then Exit Sub

Application.ScreenUpdating = False

' Open select file, mark columns
Workbooks.OpenText Filename:= _
omaTiedosto, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth,
FieldInfo:=Array( _
Array(0, 1), Array(4, 9), Array(37, 2), Array(53, 2), Array(69,
2)), TrailingMinusNumbers:=True
' Replacing
Columns("A:A").Select
Selection.Replace What:="Rota", Replacement:="", LookAt:=xlWhole,
_
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="As.N", Replacement:="", LookAt:=xlWhole,
_
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="----", Replacement:="", LookAt:=xlWhole,
_
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Laiterekisterisiivous.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Application.DisplayAlerts = False
ActiveWindow.ActivateNext
ActiveWindow.Close
Application.DisplayAlerts = True
Windows("Laiterekisterisiivous.xls").Activate

delete_EmptyRows

Range("A1").Select
Application.ScreenUpdating = True

End Sub

I am not expert for macros but I learnt myself lot of things during 10
years. That macro should be possible to make shorter if you are
expert.

Now I am starting to study Access cause I found new mission and it will
be more flexible to make it by Access.

Regards,
Maba