Home > Excel VBA > Delete rows by using criteria

Delete rows by using criteria

I often need to delete rows in a table, if values in a certain column are higher or lower than something.

It could be records/rows where a machine isn't running, or where the production is lower than x tonnes per day - there can be many reasons.

You can do this manually by sorting the data from e.g. lowest to highest, but it is easier and faster to use VBA macros. On this page I show how to do just that.

The macros use Ranges, Arrays, UserForms (also modeless), a ListBox, loops, a function that returns True or False - and more. Criteria for deletion must be numeric values, but that could be changed without too much trouble.

It is probably important to say that it is not the entire row that is deleted - it is only the row in the table, and rows below and outside the table will not change position.

I usually work with process data imported from text files (or csv), so I run the macro from one workbook and operate on the other workbook with the data, I need to analyze.

You can copy the VBA code from this page, but it is easier to download a zip-compressed workbook with the macros and UserForms: Click here to download.

The company Webucator, that offers VBA classes, has uploaded a video to YouTube showing how these macros work.

The video isn't educational in the sense that it explains the VBA code in detail (see my comments in the code below for that), but you can see how it performs.

Here we go. First we declare some variables at the module's top, and then we see the start procedure.

Option Explicit
Public bSmaller As Boolean
Public bEquals As Boolean
Public bGreater As Boolean
Public bAbort As Boolean
Public lSelCol As Long
Public dSortVal As Double

Sub OpenSort()
'Removes rows from a table if values in a
'selected column meet a user defined criteria.
'That is if the value is less than, equals or
'is bigger than a user defined value.

Dim vInput

On Error GoTo ErrorHandle

'Shows a message box
vInput = MsgBox("Removes rows in a table, if values in a column" _
& vbNewLine & _
"meets a user defined condition, like " & vbNewLine & _
"e.g. less than a certain value. " & vbNewLine & _
"Beware that numbers in the table can be rounded.", _
vbOKCancel, "Remove rows")
              
'If the user cancelled
If vInput = vbCancel Then Exit Sub

'The table with data is expected to be in another workbook
If Workbooks.Count = 1 Then
   MsgBox "You need to open the workbook containing data."
   Exit Sub
ElseIf Workbooks.Count = 2 Then
   If Workbooks(Workbooks.Count).Name = ThisWorkbook.Name Then
      Workbooks(1).Activate
   Else
      Workbooks(Workbooks.Count).Activate
   End If
   Criteria 'Calls the Criteria procedure
Else
   'If there are more than 2 open workbooks,
   'the user must activate the right one.
   Workbooks(Workbooks.Count).Activate
   With frmPickSheet
      'With Excel 2013 a modeless UserForm doesn't hover on top
      'as it used to do, but by setting StartUpPosition = 3
      'you can position it in the upper left corner making it
      'easier to find when you have 2 windows open.
      .StartUpPosition = 3
      .Show vbModeless
   End With
End If

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure OpenSort"
End Sub

Towards the end of the procedure we open a UserForm (frmPickSheet), if there are more than 2 open workbooks.

Normally a UserForm has focus, and you can't work outside the form before it is closed, but by adding "vbModeless" the form just "hovers," and the user can do other things like (in this case) activating the workbook and sheet with the data.

In the spreadsheet, you can download, it looks like this:

Modeless UserForm

The UserForm has but little code, and "cmdOK" is the name of the OK-button:

Private Sub cmdOK_Click()

On Error GoTo ErrorHandle

Unload Me

Criteria 'Calls the procedure Criteria

Exit Sub
ErrorHandle:
MsgBox Err.Description
End Sub

You can see the Criteria procedure below. First it shows a UserForm, frmSelectColumn, with a ListBox, where the user must select the column that contains the values that determine which rows to delete.

After that it shows another UserForm, where the user must define the criteria for deleting rows - e.g. values < 4000.

The next step is to copy the table to an array, MyArray. Here we loop through the selected column, and all rows except those marked for deletion are copied to another array, NewArray. The old table with data is replaced with the new one in NewArray.

Let's go.

Sub Criteria()
Dim bDelete As Boolean
Dim MyArray() As Variant    'Input array
Dim NewArray() As Variant   'Output array
Dim rCell As Range          'Range variable
Dim rTable As Range         'Range variable
Dim lRows As Long           'Number of rows
Dim lCols As Long           'Number of columns
Dim lCount As Long          'Counter
Dim lCount2 As Long         'Counter
Dim lCount3 As Long         'Counter
Dim lDelete As Long         'Counter
Dim lStartRow As Long

On Error GoTo ErrorHandle

If Len(Range("A1").Value) = 0 Then
    MsgBox "The table must start in cell A1."
    Exit Sub
End If

'Select the column to search
frmSelectColumn.Show

If bAbort Then
   bAbort = False
   GoTo BeforeExit
End If

'Define criteria
frmCriteria.Show
If bAbort Then
   bAbort = False
   GoTo BeforeExit
End If

Application.ScreenUpdating = False

'Set rTable = the table
Set rTable = Range("A1").CurrentRegion

With rTable
   lCols = .Columns.Count 'Number of columns
   lRows = .Rows.Count    'Number of rows
End With

'Copy table to MyArray
MyArray = rTable.Value

'Free memory
Set rTable = Nothing

'Finds the first row with a numeric value.
'That is where we start the loop.
For lCount = 1 To lRows
   If IsNumeric(MyArray(lCount, lSelCol)) Then
      lStartRow = lCount
      Exit For
   End If
Next

If lStartRow = lRows Then
   MsgBox "The column has no numeric values."
   GoTo BeforeExit
End If

'Now we loop through the column in the array
For lCount = lStartRow To lRows Step 1
   'If the value is numeric
   If IsNumeric(MyArray(lCount, lSelCol)) Then
      'We call the function DeleteRow that returns
      'True or False, if the row should be deleted
      'or not.
      bDelete = DeleteRow(MyArray(lCount, lSelCol))
      If bDelete = True Then
         MyArray(lCount, 1) = "delete"
         lDelete = lDelete + 1
      End If
   End If
Next

If lDelete = 0 Then
   MsgBox "No values met the criterion."
   GoTo BeforeExit
End If

'Redimension the output array that will
'hold the final table.
ReDim NewArray(1 To lRows - lDelete, 1 To lCols)

'Copy the rows except the ones that met the criterion
For lCount = 1 To lRows
   If MyArray(lCount, 1) <> "delete" Then
      lCount3 = lCount3 + 1
      For lCount2 = 1 To lCols
         NewArray(lCount3, lCount2) = MyArray(lCount, lCount2)
      Next
   End If
Next

'Delete the old table
Set rTable = Range("A1").CurrentRegion
rTable.ClearContents

'Define a new range starting in cell A1 with
'the same dimensions as NewArray.
Set rTable = Range("A1")
Set rTable = rTable.Resize(UBound(NewArray), lCols)

'Copy NewArray to the range.
rTable.Value = NewArray

BeforeExit:
On Error Resume Next
Erase MyArray
Erase NewArray
Set rTable = Nothing
bAbort = False
lSelCol = 0
Application.ScreenUpdating = True

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure Criteria"
Resume BeforeExit
End Sub

On the way we showed 2 UserForms, frmSelectColumn and frmCriteria, to get user input.

In the spreadsheet for download they look like this. First frmSelectColumn with code.

ListBox

The code finds the headers (if any) in the first row. Below the code in frmSelectColumn.

Private Sub UserForm_Initialize()
'Executes before the form opens
Dim rCell As Range
Dim rRow As Range

If IsEmpty(Range("A1")) Then
   MsgBox "Cell A1 is empty. The macro stops."
   bAbort = True
   Unload Me
End If

'Fill the ListBox
If IsEmpty(Range("B1")) = False Then
   Set rRow = Range(Range("A1"), Range("A1").End(xlToRight))
   For Each rCell In rRow
      ListBox1.AddItem rCell.Value
   Next
Else
   ListBox1.AddItem Range("A1").Value
End If

BeforeExit:
Set rCell = Nothing
Set rRow = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure UserForm_Initialize"
Resume BeforeExit
End Sub

Private Sub CommandButton1_Click()
'The OK button's click procedure
With ListBox1
   If .ListIndex = -1 Then
      MsgBox "You must select a column."
   Else
      lSelCol = .ListIndex + 1
      Unload Me
   End If
End With
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'If the form is closed by clicking the top right cross
If CloseMode = vbFormControlMenu Then
    CommandButton2_Click
End If
End Sub

Private Sub CommandButton2_Click()
'The Cancel button's click procedure
bAbort = True
Unload Me
End Sub

The UserForm for defining deletion criteria looks like this in my example:

Criteria

and has the following code:

Private Sub UserForm_Initialize()
'Excecutes before the form opens
OptionButton1.Value = True
TextBox1.SetFocus
End Sub

Private Sub OptionButton1_Click()
TextBox1.SetFocus
End Sub

Private Sub OptionButton2_Click()
TextBox1.SetFocus
End Sub

Private Sub OptionButton3_Click()
TextBox1.SetFocus
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Accepts only numeric values, minus, comma and period
Select Case KeyAscii
   Case 44 To 57
   Case Else
      KeyAscii = 0
End Select
End Sub

Private Sub CommandButton1_Click()
'The OK button's click procedure

With TextBox1
   If Len(.Text) > 0 Then
      dSortVal = CDbl(.Text)
   Else
      MsgBox "You must write a value."
      Exit Sub
   End If
End With

If OptionButton1.Value = True Then
   bSmaller = True
   bEquals = False
   bGreater = False
End If
If OptionButton2.Value = True Then
   bEquals = True
   bSmaller = False
   bGreater = False
End If
If OptionButton3.Value = True Then
   bGreater = True
   bSmaller = False
   bEquals = False
End If

Unload Me

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'If the form is closed by clicking the top right cross
If CloseMode = vbFormControlMenu Then
    bAbort = True
    Unload Me
End If
End Sub

The last thing is the Boolean function, DeleteRow.

Function DeleteRow(ByVal dVal As Double) As Boolean

If bSmaller Then
   If dVal < dSortVal Then
      DeleteRow = True
      Exit Function
   Else
      DeleteRow = False
      Exit Function
   End If
End If

If bEquals Then
   If dVal = dSortVal Then
      DeleteRow = True
      Exit Function
   Else
      DeleteRow = False
      Exit Function
   End If
End If

If bGreater Then
   If dVal > dSortVal Then
      DeleteRow = True
      Exit Function
   Else
      DeleteRow = False
      Exit Function
   End If
End If

End Function

That was it. You could make it possible to add more criteria, but the macro is actually pretty fast, so you can just run it again for deleting more rows.

You can copy-paste the code on this page, but it is easier to download the sample spreadsheet.

Related: