Large Excel Document - remove entries (multiple)

Hi there,

I have a large excel file (it will have tens of thousands of entries in) and I would like to filter and delete out rows that are not needed (because the file is so large copying it makes the computer hang!).

I would like help in identifying the best way to use VBA to remove rows based on a criteria - but I am not sure the criteria is the easy to do.

I would like to remove any row where Email 1 equals Email 2 BUT the date in (Week Ending) must also be in the last 15 days.

On top of this I would like to remove any row where the value in column B is Xe. I would also like to remove any row where the value in column Q is Service 44!

Any help is greatly appreciated - my example workbook is attached.


Who is Participating?
Michael FowlerSolutions ConsultantCommented:
This will do it for you. The public const value are just to make it easier to change columns. I also used caps insensitive comparisons just to be sure

Public Const GE_TYPE As String = "B"
Public Const EMAIL_1 As String = "F"
Public Const EMAIL_2 As String = "H"
Public Const WEEK_ENDING As String = "K"
Public Const SERVICE_TYPE As String = "Q"

Sub Filter()
    Dim lastrow As Long, i As Long
    Dim delete As Boolean
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = lastrow To 2 Step -1
        delete = False
        If UCase(Range(EMAIL_1 & i).Value) = UCase(Range(EMAIL_2 & i).Value) And _
                Now - Range(WEEK_ENDING & i).Value > 15 Then
            delete = True
        ElseIf UCase(Range(GE_TYPE & i).Value) = "XE" Then
            delete = True
        ElseIf UCase(Range(SERVICE_TYPE & i).Value) = "SERVICE 44" Then
            delete = True
        End If
        If delete Then
            Range("A" & i).EntireRow.delete
        End If
    Application.ScreenUpdating = True
End Sub

Open in new window

So it looks like you have 4 criteria to check.

I'd iterate through each row and then check the row for the criteria. Since you want to remove rows along the way, you will either need to decrement the counter when you remove a row, or start at the end and work your way backwards, which might be quicker.

Try something like this:
Sub CleanRows()
   Dim row as Integer
   For row = Selection.SpecialCells(xlCellTypeLastCell).Row to 1 step -1
      If RowToRemove(row) Then
         'Rows("1:1").Delete Shift:=xlUp   ' <= comment this out until you have a chance to verify that it is working
         Debug.print "deleted row " & row
      End If
End Sub

Function RowToRemove(row As Integer) as Boolean
   Dim CanRemove As Boolean
   Const Email1Column = 9991
   Const Email2Column = 9992
   Const WeekEndingColumn = 9993
   Const BColumn = 2
   Const QColumn = 17
   CanRemove = False

   if cells(row, Email1Column).value = cells(row, Email2Column).value then
      CanRemove = True
   ElseIf cells(row, WeekEndingColumn).value < now()-15 Then
      CanRemove = True
   ElseIf cells(row, BColumn).value = "Xe" Then
      CanRemove = True
   ElseIf cells(row, QColumn).value = "Service 44" Then
      CanRemove = True
   End If

   RowToRemove = CanRemove
End Function

Open in new window

oh, and change the constants in RowToRemove to match the correct columns
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.