VBA to delete empty rows

[squippe]

I want VBA to delete empty rows on each sheet.

Also this needs to be repaired:


For Each Cell In Sheets(1).Range("AF:AF")
If Cell.Value <> "FI " Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Cut
Sheets("Ruotsi").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Suomi").Select
End If
Next
End Sub

If there is 10 000 rows, excel goes through each of them and it takes forever. Any ideas?

[mdmackillop]

You're a bit vague on detail but try this. Also, please give your posts meaningful titles. Everyone "needs help"

With Sheets("Ruotsi")
Sheets("Suomi").Cells.Copy .Range("A1")
.Columns("AF:AF").AutoFilter Field:=1, Criteria1:="FI "
.Columns("AF:AF").SpecialCells(2).EntireRow.ClearContents
.Columns("AF:AF").AutoFilter
End With
With Sheets("Suomi")
.Columns("AF:AF").AutoFilter Field:=1, Criteria1:="<>FI "
.Columns("AF:AF").SpecialCells(xlCellTypeVisible).EntireRow.ClearContents
End With

[Paul_Hossler]

But at least you did say 'Please'

It's always nice to be polite, since more people will be inclined to offer help and suggestions

[squippe]

Sorry im a new user here (as you can tell). Cant find where to change the title afterwards.

So...

I have cut & pasted some selected rows from sheet 1 to 4 other sheets depending on the data. What I would like to do next is to cut all rows where .range("AX:AX") <> ("FI ") and paste these rows in "sheet4".
And finally I would like to delete every empty row on each sheet so that there is no empty rows between. Havent figured out these yet... Thanks for your help.

[Aussiebear]

Perhaps you can try this example:

Sub DeleteBlankRows()
'Deletes the entire row within the selection if the ENTIRE row contains no data.
Dim i As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

[Aussiebear]

Or perhaps this one from NateO might be useful;

Sub DelBlankRows()
' Note this one uses Column D as the test. Change to column A if this is more effective
[D:D].SpecialCells(xlBlanks).EntireRow.Delete
End Sub

[squippe]

Sorry im a new user here (as you can tell). Cant find where to change the title afterwards.

So...

I have cut & pasted some selected rows from sheet 1 to 4 other sheets depending on the data. What I would like to do next is to cut all rows where .range("AX:AX") <> ("FI ") and paste these rows in "sheet4".
And finally I would like to delete every empty row on each sheet so that there is no empty rows between. Havent figured out these yet... Thanks for your help.

How should I modify this in order to stop the macro on the last row which contains data:
For Each Cell In Sheets(1).Range("AF:AF")
If Cell.Value <> "FI " Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Cut
Sheets("Ulkolaiset").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Suomi").Select
End If
Next


The problem now is that if there is no data on AF:AF cell, macro wont stop.

[mdmackillop]

For Each Cell In intersect(Sheets(1).Range("AF:AF"),Sheets(1).UsedRange)

[jolivanes]

Here is another possibility to delete all empty rows in all sheets in workbook. No looping and no selecting required.


Sub Del_All_Empty_Rows()
Dim i As Long, lr As Long, lc As Long
Application.ScreenUpdating = False
For i = 1 To ActiveWorkbook.Sheets.Count
With Sheets(i)
lr = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
lc = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
With .Range(.Cells(2, lc + 1), .Cells(lr, lc + 1))
.Formula = "=COUNTA(RC[-" & lc & "]:RC[-1])"
.Value = .Value
End With
.Columns(lc + 1).AutoFilter 1, 0
.UsedRange.Offset(1).EntireRow.Delete
.AutoFilterMode = False
.Columns(lc + 1).Delete
End With
Next i
Application.ScreenUpdating = True
End Sub


@Aussiebear
Re: Or perhaps this one from NateO might be useful
That goes back in time.