If values not present, delete rows contain values

[BustedAvi]

Hi all,

I'm a very noob VBA writer and I've done my best to figure this out, but to no avail.

I have a list of words in column A. I need a macro that will search column A for five different words. If all five are present, I need 2 rows containing specific text (also in column A) to be deleted.

I appreciate the help.

 

[Peter_SSs]

Could you give us details of the 5 words to look for?
Could you give us details about the other two 'specific text' rows?

 

[BustedAvi]

No Problem.

For example:

I'd like to search column A for "E. Coli","Arsenic","Manganese","Fluoride","Nitrate","Total Coliforms", and "Nitrite". (7 words actually. Sorry I thought I'd simplify)

If ANY of these are missing from column A, I'd like the rows containing "DWQI Aesthetic" and "Aesthetic Rating" to be deleted.

Sorry about the confusion.

 

[Jon von der Heyden]

Please test this on a copy of your sheet first:

Public Sub jgukfdubgksduh()
    Dim rng As Range
    Dim strFormula As String: strFormula = "PRODUCT(--(COUNTIF([rng],{[vals]})>0))"
    Const strFind As String = """E. Coli"",""Arsenic"",""Manganese"",""Fluoride"",""Nitrate"",""Total Coliforms"",""Nitrite"""
    Dim varDelete As Variant: varDelete = VBA.Array("DWQI Aesthetic", "Aesthetic Rating")
    
    With Sheet1 '< change to whatever sheet this is in your workbook
        .AutoFilterMode = False
        Set rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
    End With
    
    With rng
        strFormula = Replace$(strFormula, "[rng]", .Address(, , , True))
        strFormula = Replace$(strFormula, "[vals]", strFind)
        If CBool(Evaluate(strFormula)) Then
            MsgBox "All values found, no further action taken!"
        Else
            .AutoFilter Field:=1, Criteria1:="=" & varDelete(0), Operator:=xlOr, Criteria2:="=" & varDelete(1)
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .AutoFilter
            MsgBox "Some values missing, rows deleted!"
        End If
    End With
End Sub

 

[Peter_SSs]

For the future you will get many more helpers if you can post a copyable screen shot directly in your post. Most helpers here don't much like typing out test data.
Check my signature block for some options.

Try this in copy of your workbook.

You could add/remove words with both lists by adjusting the arrays near the top of the code.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> CheckVals()<br>    <SPAN style="color:#00007F">Dim</SPAN> ChkWords, DelWords<br>    <SPAN style="color:#00007F">Dim</SPAN> bStop <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> Found <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    ChkWords = Array("E. Coli", "Arsenic", "Manganese", "Fluoride", _<br>        "Nitrate", "Total Coliforms", "Nitrite")<br>    DelWords = Array("DWQI Aesthetic", "Aesthetic Rating")<br>    <br>    i = <SPAN style="color:#00007F">LBound</SPAN>(ChkWords)<br>    <SPAN style="color:#00007F">With</SPAN> Range("A4", Range("A" & Rows.Count).End(xlUp))<br>        <SPAN style="color:#00007F">Do</SPAN><br>            <SPAN style="color:#00007F">Set</SPAN> Found = .Find(What:=ChkWords(i), LookIn:=xlValues, _<br>                LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)<br>            <SPAN style="color:#00007F">If</SPAN> Found <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>                bStop = <SPAN style="color:#00007F">True</SPAN><br>            <SPAN style="color:#00007F">Else</SPAN><br>                i = i + 1<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">While</SPAN> <SPAN style="color:#00007F">Not</SPAN> bStop And i <= <SPAN style="color:#00007F">UBound</SPAN>(ChkWords)<br>        <SPAN style="color:#00007F">If</SPAN> bStop <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#00007F">For</SPAN> i = <SPAN style="color:#00007F">LBound</SPAN>(DelWords) <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(DelWords)<br>                <SPAN style="color:#00007F">Set</SPAN> Found = .Find(What:=DelWords(i), LookIn:=xlValues, _<br>                    LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)<br>                <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> Found <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>                    Found.EntireRow.Delete<br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">Next</SPAN> i<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[BustedAvi]

I'm getting a compile error:

Please test this on a copy of your sheet first:

Public Sub jgukfdubgksduh()
    Dim rng As Range
    Dim strFormula As String: strFormula = "PRODUCT(--(COUNTIF([rng],{[vals]})>0))"
    Const strFind As String = """E. Coli"",""Arsenic"",""Manganese"",""Fluoride"",""Nitrate"",""Total Coliforms"",""Nitrite"""
    Dim varDelete As Variant: varDelete = VBA.Array("DWQI Aesthetic", "Aesthetic Rating")
    
    With Sheet1 '< change to whatever sheet this is in your workbook
        .AutoFilterMode = False
        Set rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
    End With
    
    With rng
        strFormula = Replace$(strFormula, "[rng]", .Address(, , , True))
        strFormula = Replace$(strFormula, "[vals]", strFind)
        If CBool(Evaluate(strFormula)) Then
            MsgBox "All values found, no further action taken!"
        Else
            .AutoFilter Field:=1, Criteria1:="=" & varDelete(0), Operator:=xlOr, Criteria2:="=" & varDelete(1)
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .AutoFilter
            MsgBox "Some values missing, rows deleted!"
        End If
    End With
End Sub

 

[hippiehacker]

Sub Delete()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long
    Dim Arrnames As Variant
    Dim ArrDel As Variant
    Dim Found As Range
    Dim FDEL As Range
 
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    'We use the ActiveSheet but you can replace this with
    'Sheets("MySheet")if you want
    With ActiveSheet
        'We select the sheet so we can change the window view
        .Select
        'If you are in Page Break Preview Or Page Layout view go
        'back to normal view, we do this for speed
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView
        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False
        'Set the first and last row to loop through
        Firstrow = .UsedRange.Cells(1).Row
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        'We loop from Lastrow to Firstrow (bottom to top)
        For Lrow = Lastrow To Firstrow Step -1
            'We check the values in the A column in this example
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
 
            Arrnames = Array("E. Coli", "Arsenic", "Manganese", "Fluoride", "Nitrate", "Total Coliforms", "Nitrite")
            Set Found = Columns("A").Find(what:=Arrnames, LookIn:=xlValues, lookat:=xlWhole)
 
              If Not Found Is Nothing Then
 
 
           ArrDel = Array("DWQI Aesthetic", "Aesthetic Rating")
            Set FDEL = Columns("A").Find(what:=ArrDel, LookIn:=xlValues, lookat:=xlWhole)
 
              If Not FDEL Is Nothing Then .EntireRow.Delete
                   
                End If
               End If
            End With
        Next Lrow
    End With
    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub

 

[BustedAvi]

This kind of works, except when I tested it with all of the values present, it still deletes the rows DWQI Aesthetic and Aesthetic Rating.

Sub Delete()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long
    Dim Arrnames As Variant
    Dim ArrDel As Variant
    Dim Found As Range
    Dim FDEL As Range
 
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    'We use the ActiveSheet but you can replace this with
    'Sheets("MySheet")if you want
    With ActiveSheet
        'We select the sheet so we can change the window view
        .Select
        'If you are in Page Break Preview Or Page Layout view go
        'back to normal view, we do this for speed
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView
        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False
        'Set the first and last row to loop through
        Firstrow = .UsedRange.Cells(1).Row
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        'We loop from Lastrow to Firstrow (bottom to top)
        For Lrow = Lastrow To Firstrow Step -1
            'We check the values in the A column in this example
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
 
            Arrnames = Array("E. Coli", "Arsenic", "Manganese", "Fluoride", "Nitrate", "Total Coliforms", "Nitrite")
            Set Found = Columns("A").Find(what:=Arrnames, LookIn:=xlValues, lookat:=xlWhole)
 
              If Not Found Is Nothing Then
 
 
           ArrDel = Array("DWQI Aesthetic", "Aesthetic Rating")
            Set FDEL = Columns("A").Find(what:=ArrDel, LookIn:=xlValues, lookat:=xlWhole)
 
              If Not FDEL Is Nothing Then .EntireRow.Delete
                   
                End If
               End If
            End With
        Next Lrow
    End With
    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub

 

[Jon von der Heyden]

I was referring to the sheet code name. You would need to use:

With Sheets("Page 1")

 

[BustedAvi]

Hey Peter,

I appreciate you pointing out how to block post. Just saw your post now actually. Thanks for the tip.

Also, your code works perfectly. Thanks so much.