Deleting Rows

Delete Rows or Columns

Following are some different ways in which rows or columns can be deleted.


Delete Blank Rows

[sourcecode language=”vb” light=”true” wraplines=”false” gutter=”false”]
Sub DeleteRows()
For i=range("A65000").end(xlup).row to 2 step -1
if application.counta(rows(i))=0 then rows(i).Delete
Next
End Sub
[/sourcecode]


Delete rows with an “X” in column A

[sourcecode language=”vb” light=”true” wraplines=”false” gutter=”false”]
Sub DeleteWithX()
LastRow = Cells(Rows.count, 1).End(xlUp).Row
For Y = LastRow To 2 Step -1
If Cells(Y, "A").Value = "X" Then Rows(Y).EntireRow.Delete
Next Y
End Sub
[/sourcecode]


Delete rows based on blanks in a particular column

[sourcecode language=”vb” light=”true” wraplines=”false” gutter=”false”]
On Error Resume Next ‘ In case there are no blanks
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange ‘ Resets UsedRange for Excel 97
[/sourcecode]


Delete Rows that have “ANN” anywhere within the worksheet

This code will delete all rows where a cell contains the text “ANN” anywhere within such cells. (e.g. ANNxxx xxANNxx xxANN) – From a posting by Patrick Molloy

[sourcecode language=”vb” light=”true” wraplines=”false” gutter=”false”]
Option Explicit
Sub Find_ANN()
Dim rng As Range
Dim what As String
what = "ANN"
Do
Set rng = ActiveSheet.UsedRange.Find(what)
If rng Is Nothing Then
Exit Do
Else
Rows(rng.Row).Delete
End If
Loop
End Sub
[/sourcecode]


Delete Rows Based on Criteria or Condition

[sourcecode language=”vb” light=”true” wraplines=”false” gutter=”false”]
Option Explicit
Sub DeleteBasedOnCriteria()

Dim rRange As Range
Dim strCriteria As String
Dim lCol As Long
Dim rHeaderCol As Range
Dim xlCalc As XlCalculation
Const strTitle As String = " CONDITIONAL ROW DELETE"

On Error Resume Next
‘We use Application.InputBox type 8 so user can select range
Set rRange = Application.InputBox(Prompt:="Select range including header range" _
, Title:=strTitle & " STEP 1 of 3", Default:=ActiveCell.CurrentRegion.Address, Type:=8)

If rRange Is Nothing Then Exit Sub ‘Cancelled or non valid rage
Application.Goto rRange.Rows(1), True

‘We use Application.InputBox type 1 so return a number
lCol = Application.InputBox(Prompt:="Please enter relative column number of eval column" _
, Title:=strTitle & " STEP 2 of 3", Default:=1, Type:=1)

If lCol = 0 Then Exit Sub ‘Cancelled

‘We use default InputBox type as we want Text
strCriteria = InputBox(Prompt:="Please enter a single criteria." & _
vbNewLine & "Eg >5 OR <10 OR Cat* OR *Cat OR *Cat*" _
, Title:=strTitle & " STEP 3 of 3")
If strCriteria = vbNullString Then Exit Sub

‘Store current Calculation then switch to manual.
‘Turn off events and screen updating
With Application
xlCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With

ActiveSheet.AutoFilterMode = False ‘Remove any filters

With rRange ‘Filter, offset(to exclude headers) and delete visible rows
.AutoFilter Field:=lCol, Criteria1:=strCriteria
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With

ActiveSheet.AutoFilterMode = False ‘Remove any filters

With Application ‘Revert back
.Calculation = xlCalc
.EnableEvents = True
.ScreenUpdating = True
End With
On Error GoTo 0
End Sub
[/sourcecode]


Delete Rows Based on Criteria or Condition (B)

[sourcecode language=”vb” light=”true” wraplines=”false” gutter=”false”]
Option Explicit
Sub DeleteBasedOnCriteriaSlower()

Dim rTable As Range
Dim rCol As Range, rCell As Range
Dim lCol As Long
Dim xlCalc As XlCalculation
Dim vCriteria

On Error Resume Next
With Selection ‘Determine the table range
If .Cells.Count > 1 Then
Set rTable = Selection
Else
Set rTable = .CurrentRegion
On Error GoTo 0
End If
End With

‘Determine if table range is valid
If rTable Is Nothing Or rTable.Cells.Count = 1 Or WorksheetFunction.CountA(rTable) < 2 Then
MsgBox "Could not determine you table range.", vbCritical, "Ozgrid.com"
Exit Sub
End If

‘Get the criteria in the form of text or number.
vCriteria = Application.InputBox(Prompt:="Type in the criteria that matching _
rows should be deleted. " & "If the criteria is in a cell, point to the cell _
with your mouse pointer", Title:="CONDITIONAL ROW DELETION CRITERIA", _
Type:=1 + 2)

If vCriteria = "False" Then Exit Sub ‘Go no further if they Cancel.

‘Get the relative column number where the criteria should be found
lCol = Application.InputBox(Prompt:="Type in the relative number of the column where " _
& "the criteria can be found.", Title:="CONDITIONAL ROW DELETION COLUMN NUMBER", Type:=1)

If lCol = 0 Then Exit Sub ‘Cancelled
Set rCol = rTable.Columns(lCol) ‘Set rCol to the column where criteria should be found
Set rCell = rCol.Cells(2, 1) ‘Set rCell to the first data cell in rCol

‘Store current Calculation then switch to manual.
With Application ‘Turn off events and screen updating
xlCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With

‘Loop and delete as many times as vCriteria exists in rCol
For lCol = 1 To WorksheetFunction.CountIf(rCol, vCriteria)
Set rCell = rCol.Find(What:=vCriteria, After:=rCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Offset(-1, 0)
rCell.Offset(1, 0).EntireRow.Delete
Next lCol

With Application
.Calculation = xlCalc
.EnableEvents = True
.ScreenUpdating = True
End With
On Error GoTo 0

End Sub
[/sourcecode]