VBA to Delete rows if missing values across multiple columns

ENicklin

New Member
Joined
Oct 2, 2021
Messages
11
Office Version
  1. 2019
Platform
  1. Windows
Hello,

I need to search through data from an online database and filter it based on certain criteria than can appear in multiple columns. I have copied the data into an excel sheet and the first batch is about 4k rows long and I probably only need to keep about 25% of that. My sheet is currently 7 columns wide (A-G) I need a code to search columns C, D, E and G and only keep the rows that have the following terms in them:

Cornerstone on Booth
A Different Street (JHS program)
Centre 507
Centretown CHC
Carleton University
ODSP
Emergency Medical Services
Friendship Centre, ODAWA
Haven Youth
JF Norwood, Eliz Fry
Library , Ottawa
ODAWA Native Friendship Centre
ODSP
Ontario Works
Ottawa Police
Somerset West CHC
St.Lukes
SWCHC
Tom Brown Arena
Well , The
YMCA
YMCA Employment Centre
Other (Please Specify)

I need to keep all the rows that have any of these terms in columns C, D, E, and G but if the terms are missing in all the columns then I want to delete the rows. I have found solutions to delete rows based on searches but not to keep rows and delete everything else and when I tried editing the code I just ended up deleting everything.

Any help is appreciated. Cheers,
 

cmowla

Board Regular
Joined
Sep 21, 2021
Messages
243
Office Version
  1. 365
Platform
  1. Windows
I'm not sure what's wrong. Do you have Office 365? Here the Workbook that I have to see if it still gives you an error. (It looks like you did exactly what I did, as you said, but just in case!)

EDIT: And I forgot to change J1 to J2 and J23 to J24. (I just put "Keywords" in J1 but forgot to change the parameters.)
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

ENicklin

New Member
Joined
Oct 2, 2021
Messages
11
Office Version
  1. 2019
Platform
  1. Windows
I'm not sure what's wrong. Do you have Office 365? Here the Workbook that I have to see if it still gives you an error. (It looks like you did exactly what I did, as you said, but just in case!)

EDIT: And I forgot to change J1 to J2 and J23 to J24. (I just put "Keywords" in J1 but forgot to change the parameters.)
Apparently I don't have 365. I have Office 2019 (standard) so that is probably why it won't work.
 

cmowla

Board Regular
Joined
Sep 21, 2021
Messages
243
Office Version
  1. 365
Platform
  1. Windows
Apparently I don't have 365. I have Office 2019 (standard) so that is probably why it won't work.
Well I guess you will have to go with the previous poster's solution (if it works for you). Maybe I or someone can tweak this to work in your version, but I saw 365 in your profile. Oh well.
 

ENicklin

New Member
Joined
Oct 2, 2021
Messages
11
Office Version
  1. 2019
Platform
  1. Windows
Well I guess you will have to go with the previous poster's solution (if it works for you). Maybe I or someone can tweak this to work in your version, but I saw 365 in your profile. Oh well.
Sorry I probably didn't fill that out correctly. Thanks again.
 
Last edited:

cmowla

Board Regular
Joined
Sep 21, 2021
Messages
243
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Question: this did work though I realized I need one more filter. On rows that have

Sorry I probably didn't fill that out correctly. Thanks again.
There is an option to select 2019. Please change it so that you don't waste people's time in the future again, thanks!

And you could have at least checked when I mentioned this earlier since you were unsure:
Also, here's how to do this without VBA (in Office 365, which I see you have). Set up the formulas in a sheet in the following way.
 
Last edited:

ENicklin

New Member
Joined
Oct 2, 2021
Messages
11
Office Version
  1. 2019
Platform
  1. Windows
Hi ENicklin,

Try this (initially on a copy of your data as the results cannot be undone if they're not as expected) where each of the 23 text items are in Col. A of the 'wsLookup' tab:

VBA Code:
Option Explicit
Sub Macro1()

    Dim wsData As Worksheet, wsLookup As Worksheet
    Dim lngMyRow As Long, lngLastRow As Long
    Dim dblResult As Double
    Dim varMyCol As Variant
  
    Application.ScreenUpdating = False
  
    Set wsData = ThisWorkbook.Sheets("Sheet1") 'Sheet name that has the data in columns C, D, E and G. Change to suit if necessary.
    Set wsLookup = ThisWorkbook.Sheets("Sheet2") 'Sheet name that has filter criteria. Change to suit if necessary.
  
    If WorksheetFunction.CountA(wsData.Cells) = 0 Then
        MsgBox "There is no data in """ & wsData.Name & """ to work with.", vbExclamation
        Exit Sub
    End If
  
    lngLastRow = wsData.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For lngMyRow = lngLastRow To 2 Step -1 'Assumes the fist row of data is 2 (1 being for headers). Change to suit if necessary.
        For Each varMyCol In Array("C", "D", "E", "G") 'Columns with possible filter criteria. Change to suit if necessary.
            dblResult = dblResult + Application.WorksheetFunction.CountIf(wsLookup.Range("A:A"), wsData.Range(CStr(varMyCol) & lngMyRow)) 'Assumes criteria are in column A of 'wsLookup'. Change to suit if necessary.
            If dblResult > 0 Then
                Exit For
            End If
        Next varMyCol
        If dblResult = 0 Then
            wsData.Rows(lngMyRow).Delete
        End If
        dblResult = 0
    Next lngMyRow
  
    Application.ScreenUpdating = True

End Sub

Regards,

Robert
Thanks. This seems to work. Hopefully next time I can figure out the advanced filtering but this is good for now.

Cheers!
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
52,263
Office Version
  1. 365
Platform
  1. Windows
I can't upload a minisheet because I am on a work computer and cannot install any software.
Understood. :(

The list wasn't previosly recorded but I have since added a tab with that list.
OK, good.

I note that you have a working solution and speed may not be an issue for you unless the data and/or the locations list get very large but this code is roughly 30 times faster in my tests.
If you haven't done so already, you might want to move your button up to row 1 so that can't get affected by row deletions.
This code requires that there are no blank cells in the Locations list but that seems to be the case anyway. :)
If you want to test this code, do so with a copy of your workbook
I have assumed that the data sheet (2018 in your case) is the active sheet when the code is run. I guess that will be the case if you are going to run the code from the button in that sheet.

VBA Code:
Sub Del_Rows()
  Dim RX As Object
  Dim a As Variant, b As Variant
  Dim lr As Long, i As Long, k As Long

  Application.ScreenUpdating = False
  lr = Sheets("Locations").Range("A" & Rows.Count).End(xlUp).Row
  Set RX = CreateObject("VBScript.RegExp")
  RX.Pattern = Join(Application.Transpose(Sheets("Locations").Range("A1:A" & lr).Value), "|")
  With Range("A2:H" & Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row)
    .Columns(8).Formula = "=TextJoin(""#"", 1, C2, D2, E2, G2)"
    a = .Columns(8).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If Not RX.test(a(i, 1)) Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    .Columns(8).Value = b
    If k > 0 Then
      .Sort Key1:=.Columns(8), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End If
  End With
  Application.ScreenUpdating = True
End Sub
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,821
Messages
5,766,639
Members
425,364
Latest member
jstubs99

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top