Delete Rows That Do Not Meet Criteria

[Aschr13]

Hello,

I am working in a 3,300 row excel sheet and I would like to delete the rows that I don't need. I want to delete rows that do not contain a certain NAICS classification, do not occur in a certain states, and will be awarded via "sole source" (I work in contracting).

I have tried several codes that I have found on other Mr. Excel posts and elsewhere and so far the best I've managed to do is delete the rows that contain the criteria I want to see instead of the rows do not contain the criteria. I have also run the macro and every row disappears and run the macro and seemingly random rows disappeared that were outside the criteria listed.

Here is an example of a code that worked:

Sub DeleteRowsNot_Contain()
     Dim ws As Worksheet
     Dim lastRow As Long
     Set ws = ActiveWorkbook.Sheets("Evaluating")
     lastRow = ws.Range("G" & ws.Rows.Count).End(xlUp).Row
     For i = lastRow To 1 Step -1
       If InStr(1, Cells(i, "G").Value, "541715  |   Research and Development in the Physical, Engineering, and Life Sciences (except Nanotechnology and Biotechnology", vbTextCompare) _
       Or InStr(1, cell, "512110 | Motion Picture and Video Production", 1) _
       Or InStr(1, cell, "541330  |   Engineering Services", 1) _
       Or InStr(1, cell, "562910  |   Remediation Services", 1) _
       Or InStr(1, cell, "541370  |   Surveying and Mapping (except Geophysical) Services", 1) _
       Or InStr(1, cell, "541618  |   Other Management Consulting Services", 1) _
       Or InStr(1, cell, "541620  |   Environmental Consulting Services", 1) _
       Or InStr(1, cell, "541690  |   Other Scientific and Technical Consulting Services", 1) _
       Or InStr(1, cell, "541990  |   All Other Professional, Scientific, and Technical Services", 1) _
       Or InStr(1, cell, "561110  |   Office Administrative Services", 1) _
       Or InStr(1, cell, "561320  |   Temporary Help Services", 1) _
       Or InStr(1, cell, "561990  |   All Other Support Services", 1) _
       Or InStr(1, cell, "562910  |   Remediation Services", 1) _
       Or InStr(1, cell, "611430  |   Professional and Management Development Training", 1) _
       Or InStr(1, cell, "611699  |   All Other Miscellaneous Schools and Instruction", 1) _
       Or InStr(1, cell, "611710 | Educational Support Services", 1) = 0 Then
         Rows(i).EntireRow.Delete
       End If
     Next
 End Sub

This code deleted all of the values that contained these values (the rows I want to see), instead of all the rows that did not contain these values (the rows I do not want to see). I have learned that EntireRow.Delete is why this happened. I have considered trying to do the inverse of this, rather than listing all the things I want to see, list the things I don't want to see. The problem with that is there are hundreds of values that could pop up on this excel report. It isn't feasible to code for all of the things that I don't want to see.

I'd also like to remove rows that have a Place of Performance that is not Washington, Oregon, and California and all rows that are not "competed."

I'm sure I'm leaving out important information, so please call me out and let me know what you need.

 

[BigBeachBananas]

Hello,

I am working in a 3,300 row excel sheet and I would like to delete the rows that I don't need. I want to delete rows that do not contain a certain NAICS classification, do not occur in a certain states, and will be awarded via "sole source" (I work in contracting).

I have tried several codes that I have found on other Mr. Excel posts and elsewhere and so far the best I've managed to do is delete the rows that contain the criteria I want to see instead of the rows do not contain the criteria. I have also run the macro and every row disappears and run the macro and seemingly random rows disappeared that were outside the criteria listed.

Here is an example of a code that worked:

Sub DeleteRowsNot_Contain()
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ActiveWorkbook.Sheets("Evaluating")
lastRow = ws.Range("G" & ws.Rows.Count).End(xlUp).Row
For i = lastRow To 1 Step -1
If InStr(1, Cells(i, "G").Value, "541715 | Research and Development in the Physical, Engineering, and Life Sciences (except Nanotechnology and Biotechnology", vbTextCompare) _
Or InStr(1, cell, "512110 | Motion Picture and Video Production", 1) _
Or InStr(1, cell, "541330 | Engineering Services", 1) _
Or InStr(1, cell, "562910 | Remediation Services", 1) _
Or InStr(1, cell, "541370 | Surveying and Mapping (except Geophysical) Services", 1) _
Or InStr(1, cell, "541618 | Other Management Consulting Services", 1) _
Or InStr(1, cell, "541620 | Environmental Consulting Services", 1) _
Or InStr(1, cell, "541690 | Other Scientific and Technical Consulting Services", 1) _
Or InStr(1, cell, "541990 | All Other Professional, Scientific, and Technical Services", 1) _
Or InStr(1, cell, "561110 | Office Administrative Services", 1) _
Or InStr(1, cell, "561320 | Temporary Help Services", 1) _
Or InStr(1, cell, "561990 | All Other Support Services", 1) _
Or InStr(1, cell, "562910 | Remediation Services", 1) _
Or InStr(1, cell, "611430 | Professional and Management Development Training", 1) _
Or InStr(1, cell, "611699 | All Other Miscellaneous Schools and Instruction", 1) _
Or InStr(1, cell, "611710 | Educational Support Services", 1) = 0 Then
Rows(i).EntireRow.Delete
End If
Next
End Sub

This code deleted all of the values that contained these values (the rows I want to see), instead of all the rows that did not contain these values (the rows I do not want to see). I have learned that EntireRow.Delete is why this happened. I have considered trying to do the inverse of this, rather than listing all the things I want to see, list the things I don't want to see. The problem with that is there are hundreds of values that could pop up on this excel report. It isn't feasible to code for all of the things that I don't want to see.

I'd also like to remove rows that have a Place of Performance that is not Washington, Oregon, and California and all rows that are not "competed."

I'm sure I'm leaving out important information, so please call me out and let me know what you need.

It would be helpful to attach a sample sheet of the current and expected result.

 

[Peter_SSs]

Welcome to the MrExcel board!

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

 

[alansidman]

Why not just use a simple filter which is available in Native Excel instead of a bit of long VBA code.

 

[Aschr13]

I tried to add the XL2BB extension to make this easier, but kept getting an error that said "This File Type is Not Supported in Protected View."
I hope these images help. I have heavily edited the forecast to make the images easier to see. The actual document has over 3,300 lines and columns A through X. I can get what I want by using filters but it takes far more time than I'd like to spend, especially if the issue can be solved by running a few macros.

Please let me know if I should provide anything else.

Thank you!

 

[Peter_SSs]

I tried to add the XL2BB extension to make this easier, but kept getting an error that said "This File Type is Not Supported in Protected View."

See if this helps.

 

[BigBeachBananas]

CANNOT UNDO CHANGES. Try this on a COPY of your workbook.

Sub DeleteRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim keywords As Variant

    Set ws = ActiveWorkbook.Sheets("Sheet1") 'Change sheet name as needed
    lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row

    ' Define the keywords you want to check for
    keywords = Array( _
        "541715  |   Research and Development in the Physical, Engineering, and Life Sciences (except Nanotechnology and Biotechnology", _
        "512110 | Motion Picture and Video Production", _
        "541330  |   Engineering Services", _
        "562910  |   Remediation Services", _
        "541370  |   Surveying and Mapping (except Geophysical) Services", _
        "541618  |   Other Management Consulting Services", _
        "541620  |   Environmental Consulting Services", _
        "541690  |   Other Scientific and Technical Consulting Services", _
        "541990  |   All Other Professional, Scientific, and Technical Services", _
        "561110  |   Office Administrative Services", _
        "561320  |   Temporary Help Services", _
        "561990  |   All Other Support Services", _
        "562910  |   Remediation Services", _
        "611430  |   Professional and Management Development Training", _
        "611699  |   All Other Miscellaneous Schools and Instruction", _
        "611710 | Educational Support Services")

    For i = lastRow To 1 Step -1
        Dim found As Boolean
        found = False
        For Each keyword In keywords
            If InStr(1, ws.Cells(i, "G").Value, keyword, vbTextCompare) > 0 Then
                found = True
                Exit For
            End If
        Next keyword
        If Not found Then
            ws.Rows(i).EntireRow.Delete
        End If
    Next i
End Sub

 

[Peter_SSs]

@Aschr13
Can you please confirm ..

1. that the second and last strings in the strings to check for have just a single space before and after the "|" character but all the other strings have two spaces before and three spaces after the "|" character?
   
   
2. what your actual working code is? I don't think it is what you posted in post #1 since that contains a variable 'cell' which is undefined and unpopulated in the posted code.
   
   
   
   
   
   
3. whether the values in column G can contain other text as well as the values listed or would that be the exact text? That is, could a cell in column G contain
   "541330 | Engineering Services and other text like this" or would the cell only have exactly
   "541330 | Engineering Services"

 

[Alex Blakenburg]

Ideally the class codes would be in a table and the code and description in separate columns.
I have use @BigBeachBananas array in this.

I have a lot of extra code to cover off that your screen shot is nothing like your original code ie Class in is column B not G and headings in row 3 not 1.

Sub DeleteRows_dic_v02()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long, hdgRow As Long
    Dim i As Long, j As Long
    Dim keywords As Variant
    Dim dictClass As Object, dictKey As String
    Dim rngData As Range
    Dim arrClass As Variant, arrAll As Variant
    Dim colClass As Long, colPlace As Long, colComp As Long
    Dim cntDelFlag As Long

    Set ws = ActiveWorkbook.Sheets("Evaluating")                    ' Change sheet name as needed
    colClass = Columns("G").Column                                  ' Change as required Class
    colPlace = Columns("C").Column                                  ' Change as required Place
    colComp = Columns("D").Column                                   ' Change as required Competed

    With ws
        hdgRow = 1                                                  ' Change to heading row - currently assumed 1
        lastCol = .Cells(hdgRow, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, colClass).End(xlUp).Row
        Set rngData = .Range(.Cells(hdgRow, "A"), .Cells(lastRow, lastCol))
        arrAll = rngData.Value
        arrClass = Application.Index(rngData, 0, colClass)
        arrClass = Application.Replace(Application.Trim(arrClass), 7, 200, "")
        ReDim Preserve arrClass(1 To UBound(arrClass), 1 To 2)
    End With

    ' Define the keywords you want to check for
    keywords = Array( _
        "541715  |   Research and Development in the Physical, Engineering, and Life Sciences (except Nanotechnology and Biotechnology", _
        "512110 | Motion Picture and Video Production", _
        "541330  |   Engineering Services", _
        "562910  |   Remediation Services", _
        "541370  |   Surveying and Mapping (except Geophysical) Services", _
        "541618  |   Other Management Consulting Services", _
        "541620  |   Environmental Consulting Services", _
        "541690  |   Other Scientific and Technical Consulting Services", _
        "541990  |   All Other Professional, Scientific, and Technical Services", _
        "561110  |   Office Administrative Services", _
        "561320  |   Temporary Help Services", _
        "561990  |   All Other Support Services", _
        "562910  |   Remediation Services", _
        "611430  |   Professional and Management Development Training", _
        "611699  |   All Other Miscellaneous Schools and Instruction", _
        "611710 | Educational Support Services")
        
    keywords = Application.Replace(keywords, 7, 200, "")
    Set dictClass = CreateObject("Scripting.dictionary")
    
    ' Load details range into Dictionary
    For i = 1 To UBound(keywords)
        dictKey = Str(keywords(i))
        If Not dictClass.exists(dictKey) Then
            dictClass(dictKey) = i
        End If
    Next i
    
    For j = 2 To UBound(arrClass)
        dictKey = Str(arrClass(j, 1))
        If Not dictClass.exists(dictKey) Then
            arrClass(j, 2) = 1
        ElseIf LCase(arrAll(j, colComp)) <> "competed" Then
            arrClass(j, 2) = 1

        ElseIf InStr(1, arrAll(j, colPlace), "Washington", vbTextCompare) = 0 _
                And InStr(1, arrAll(j, colPlace), "Oregon", vbTextCompare) = 0 _
                And InStr(1, arrAll(j, colPlace), "California", vbTextCompare) = 0 _
                Then
                    arrClass(j, 2) = 1
        End If

        If arrClass(j, 2) = 1 Then
            cntDelFlag = cntDelFlag + 1
        End If
    Next j
    
    Application.ScreenUpdating = False
    ws.Cells(1, lastCol + 1).Resize(UBound(arrClass)).Value = Application.Index(arrClass, 0, 2)
    
    With rngData.Resize(, rngData.Columns.Count + 1)
        .Sort Key1:=.Columns(lastCol + 1), Order1:=xlAscending, Header:=xlYes
        .Offset(1).Resize(cntDelFlag).EntireRow.Delete
    End With
    Application.ScreenUpdating = True

End Sub

 

[Aschr13]

Hello All,

Thank you to everyone that has replied. I'm very much a novice and it shows.

@BigBeachBananas - I tried the code you provided, thank you. Unfortunately, it did not make any changes to the workbook. I ran it a few additional times and had the same result.

@Peter_SSs - I have provided responses to your questions below in orange.

1. that the second and last strings in the strings to check for have just a single space before and after the "|" character but all the other strings have two spaces before and three spaces after the "|" character? Yes, that is correct. All of the fields have been copied/pasted from the excel workbook themselves. The workbook is a contract forecast released by the DOC every week and they fill in the fields, so it is very possible (maddeningly) that it was a typo in this week's forecast and they'll fix it next week...or not...or some other version of events. I recognize that this may mean that using macros is not a good idea due to the potential variability in the data, but I'd like to try anyway.
   
   
2. what your actual working code is? I don't think it is what you posted in post #1 since that contains a variable 'cell' which is undefined and unpopulated in the posted code. My working code is not at all adequate for what I'd like to achieve. I pulled it off of a different post on a different website to see if it would work. I don't know what a variable "cell" is, I didn't put it in there knowingly. The original code is in my initial post. I have pasted it below for ease of reference.
   Sub DeleteRowsNot_Contain() Dim ws As Worksheet
   Dim lastRow As Long
   Set ws = ActiveWorkbook.Sheets("Evaluating")
   lastRow = ws.Range("G" & ws.Rows.Count).End(xlUp).Row
   For i = lastRow To 1 Step -1
   If InStr(1, Cells(i, "G").Value, "541715 | Research and Development in the Physical, Engineering, and Life Sciences (except Nanotechnology and Biotechnology", vbTextCompare) _
   Or InStr(1, cell, "512110 | Motion Picture and Video Production", 1) _
   Or InStr(1, cell, "541330 | Engineering Services", 1) _
   Or InStr(1, cell, "562910 | Remediation Services", 1) _
   Or InStr(1, cell, "541370 | Surveying and Mapping (except Geophysical) Services", 1) _
   Or InStr(1, cell, "541618 | Other Management Consulting Services", 1) _
   Or InStr(1, cell, "541620 | Environmental Consulting Services", 1) _
   Or InStr(1, cell, "541690 | Other Scientific and Technical Consulting Services", 1) _
   Or InStr(1, cell, "541990 | All Other Professional, Scientific, and Technical Services", 1) _
   Or InStr(1, cell, "561110 | Office Administrative Services", 1) _
   Or InStr(1, cell, "561320 | Temporary Help Services", 1) _
   Or InStr(1, cell, "561990 | All Other Support Services", 1) _
   Or InStr(1, cell, "562910 | Remediation Services", 1) _
   Or InStr(1, cell, "611430 | Professional and Management Development Training", 1) _
   Or InStr(1, cell, "611699 | All Other Miscellaneous Schools and Instruction", 1) _
   Or InStr(1, cell, "611710 | Educational Support Services", 1) = 0 Then
   Rows(i).EntireRow.Delete
   End If
   Next
   End Sub
   
   
   
   
3. whether the values in column G can contain other text as well as the values listed or would that be the exact text? That is, could a cell in column G contain
   "541330 | Engineering Services and other text like this" or would the cell only have exactly
   "541330 | Engineering Services"

That is a great question. I would think it would have exactly the text (the latter of your examples), but because this forecast is controlled by the DOC, there may be slight variations. However, these variations are most likely to be an inconsistent number of spaces between the number sequence and the | or between the | and the start of the text.
@Alex Blakenburg - You're right. I see the confusion this would cause and I'm sorry. The actual workbook is incredibly large, so I provided screenshots of a heavily modified version that had the bare basics to try and make the entire process easier. I tried to do slight alterations to the code you provided (updated code below) to make it applicable to the entire worksheet, but now I'm getting a "mismatch key" error so I must have made a mistake somewhere.
Sub DeleteRows_dic_v02()
Dim ws As Worksheet
Dim lastRow As Long, lastCol As Long, hdgRow As Long
Dim i As Long, j As Long
Dim keywords As Variant
Dim dictClass As Object, dictKey As String
Dim rngData As Range
Dim arrClass As Variant, arrAll As Variant
Dim colClass As Long, colPlace As Long, colComp As Long
Dim cntDelFlag As Long

Set ws = ActiveWorkbook.Sheets("Evaluating") ' Change sheet name as needed
colClass = Columns("G").Column ' Change as required Class
colPlace = Columns("K").Column ' Change as required Place
colComp = Columns("Q").Column ' Change as required Competed

With ws
hdgRow = 1 ' Change to heading row - currently assumed 1
lastCol = .Cells(hdgRow, .Columns.Count).End(xlToLeft).Column
lastRow = .Cells(.Rows.Count, colClass).End(xlUp).Row
Set rngData = .Range(.Cells(hdgRow, "A"), .Cells(lastRow, lastCol))
arrAll = rngData.Value
arrClass = Application.Index(rngData, 0, colClass)
arrClass = Application.Replace(Application.Trim(arrClass), 7, 200, "")
ReDim Preserve arrClass(1 To UBound(arrClass), 1 To 2)
End With

' Define the keywords you want to check for
keywords = Array( _
"541715 | Research and Development in the Physical, Engineering, and Life Sciences (except Nanotechnology and Biotechnology", _
"512110 | Motion Picture and Video Production", _
"541330 | Engineering Services", _
"562910 | Remediation Services", _
"541370 | Surveying and Mapping (except Geophysical) Services", _
"541618 | Other Management Consulting Services", _
"541620 | Environmental Consulting Services", _
"541690 | Other Scientific and Technical Consulting Services", _
"541990 | All Other Professional, Scientific, and Technical Services", _
"561110 | Office Administrative Services", _
"561320 | Temporary Help Services", _
"561990 | All Other Support Services", _
"562910 | Remediation Services", _
"611430 | Professional and Management Development Training", _
"611699 | All Other Miscellaneous Schools and Instruction", _
"611710 | Educational Support Services")

keywords = Application.Replace(keywords, 7, 200, "")
Set dictClass = CreateObject("Scripting.dictionary")

' Load details range into Dictionary
For i = 1 To UBound(keywords)
dictKey = Str(keywords(i))
If Not dictClass.exists(dictKey) Then
dictClass(dictKey) = i
End If
Next i

For j = 2 To UBound(arrClass)
dictKey = Str(arrClass(j, 1))
If Not dictClass.exists(dictKey) Then
arrClass(j, 2) = 1
ElseIf LCase(arrAll(j, colComp)) <> "Competed" Then
arrClass(j, 2) = 1

ElseIf InStr(1, arrAll(j, colPlace), "AKAlaska", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "HIHawaii", vbTextCompare) = 0 And InStr(1, arrAll(j, colPlace), "TXTexas", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "WAWashington", vbTextCompare) = 0 And InStr(1, arrAll(j, colPlace), "CACalifornia", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "OROregon", vbTextCompare) = 0 And InStr(1, arrAll(j, colPlace), "TXTexas", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "FMFederated States of Micronesia", vbTextCompare) = 0 And InStr(1, arrAll(j, colPlace), "PRPuerto RICO", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "IDIdaho", vbTextCompare) = 0 And InStr(1, arrAll(j, colPlace), "PWPalau", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "MHMarshall Islands", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "GUGuam", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "MTMontana", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "WYWyoming", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "UTUtah", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "MPNorthern Mariana Islands", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "AS American Samoa", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "COLORADO", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "IDAHO", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "TO BE DETERMINED", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "NA", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "CALIFORNIA", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "AMERICAN SAMOA", vbTextCompare) = 0 And InStr(1, arrAll(j, colPlace), "HAWAII", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "WASHINGTON", vbTextCompare) = 0 And InStr(1, arrAll(j, colPlace), "OREGON", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "ALASKA", vbTextCompare) = 0 And InStr(1, arrAll(j, colPlace), "TEXAS", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "MONTANA", vbTextCompare) = 0 And InStr(1, arrAll(j, colPlace), "UTAH", vbTextCompare) = 0 _
And InStr(1, arrAll(j, colPlace), "PUERTO RICO", vbTextCompare) = 0 And InStr(1, arrAll(j, colPlace), "NA - Not Applicable", vbTextCompare) = 0 _
Then

arrClass(j, 2) = 1


End If

If arrClass(j, 2) = 1 Then
cntDelFlag = cntDelFlag + 1
End If
Next j

Application.ScreenUpdating = False
ws.Cells(1, lastCol + 1).Resize(UBound(arrClass)).Value = Application.Index(arrClass, 0, 2)

With rngData.Resize(, rngData.Columns.Count + 1)
.Sort Key1:=.Columns(lastCol + 1), Order1:=xlAscending, Header:=xlYes
.Offset(1).Resize(cntDelFlag).EntireRow.Delete
End With
Application.ScreenUpdating = True

End Sub