Macro to delete row if doesn't contain certain text

[srr797]

Hello,

I am in need of what seems to be a fairly simple macro, which will delete (and shift up) any row that does not contain the text "IP-0000063409" in column E.


Thanks very much!

 

[iufreak]

Thanks, Robert! Your example fixed that error, but there is one a little further down, now.

It states Run-time error '1004': Delete method of Range class failed. I have added *'s around the line where the error is now.

Option Explicit
Sub REMOVE_LEVEL()
        
    '//Declare variables//
    Dim varDelItem1 As Variant, _
        varDelItem2 As Variant, _
        varDelItem3 As Variant, _
        varDelItem4 As Variant, _
        varDelItem5 As Variant, _
        varDelItem6 As Variant, _
        varDelItem7 As Variant, _
        varDelItem8 As Variant
    Dim lngRowStart As Long, _
        lngRowLast As Long, _
        lngRowActive As Long
    Dim strMyCol As String
    Dim rngDelRange As Range
    
    '//Set variables//
    varDelItem1 = "Level 1"
    varDelItem2 = "Level 2"
    varDelItem3 = "Level 3"
    varDelItem4 = "Level 4"
    varDelItem5 = "Level 5"
    varDelItem6 = "Level 6"
    varDelItem7 = "Level 7"
    varDelItem8 = "Level 8"
    lngRowStart = 2 'Initial data row.  Change to suit.
    strMyCol = "AB" 'Column containing relevant data.  Change to suit.
    lngRowLast = Cells(Rows.Count, strMyCol).End(xlUp).Row
    
    Application.ScreenUpdating = False
        
    For lngRowActive = lngRowStart To lngRowLast
        If IsError(Cells(lngRowActive, strMyCol)) = True Then
            'Cater for initial setting of 'rngDelRange' range
            If rngDelRange Is Nothing Then
                Set rngDelRange = Cells(lngRowActive, strMyCol)
            Else
                Set rngDelRange = Union(rngDelRange, Cells(lngRowActive, strMyCol))
            End If
        Else
           If Trim(Cells(lngRowActive, strMyCol)) <> varDelItem1 And _
              Trim(Cells(lngRowActive, strMyCol)) <> varDelItem2 And _
              Trim(Cells(lngRowActive, strMyCol)) <> varDelItem3 And _
              Trim(Cells(lngRowActive, strMyCol)) <> varDelItem4 And _
              Trim(Cells(lngRowActive, strMyCol)) <> varDelItem5 And _
              Trim(Cells(lngRowActive, strMyCol)) <> varDelItem6 And _
              Trim(Cells(lngRowActive, strMyCol)) <> varDelItem7 And _
              Trim(Cells(lngRowActive, strMyCol)) <> varDelItem8 Then
                'Cater for initial setting of 'rngDelRange' range
                If rngDelRange Is Nothing Then
                    Set rngDelRange = Cells(lngRowActive, strMyCol)
                Else
                    Set rngDelRange = Union(rngDelRange, Cells(lngRowActive, strMyCol))
                End If
            End If
        End If
    Next lngRowActive
        
    'If the 'rngDelRange' range has been set (i.e. has something in it), then...
    If Not rngDelRange Is Nothing Then
        '...delete the rows within it.
        *********rngDelRange.EntireRow.Delete xlShiftUp*********
    'Else...
    Else
        '...inform the user that no rows are to be deleted.
        MsgBox "No rows were deleted.", vbExclamation, "Delete Row Editor"
    End If
    
    Application.ScreenUpdating = True
        
End Sub

 

[Trebor76]

Can't really say on that one without seeing the data. How many rows is the code trying to delete?

 

[iufreak]

It's trying to delete probably 50-100 rows out of about 13000-14000. The data in the cells are all vlookup data if that matters!

 

[Trebor76]

The data in the cells are all vlookup data if that matters!

It may do - step through the code and see if it is only capturing the 50-100 rows to be deleted. My guess is that it's not but actually trying to delete every row in the range which is too big for the 'rngDelRange' variable to handle.

 

[iufreak]

Robert,

I think I found the fix.

The original line that was returning an error was:

rngDelRange.EntireRow.Delete xlShiftUp

I replaced this with:

rngDelRange.Delete (xlShiftUp)

It seems to be working perfectly fine. Do you see any reason why this may delete other rows? It doesn't appear to be, but just want to make sure!

 

[Trebor76]

No, as long as the rows in the rngDelRange are correct it will only delete those rows.

 

[Angus_Sinclair]

Hi,
I just used this and it was very helpfull. Is there a way it can include any occassion of the word. So in this example it would include rows with "IP-0000063409", but also rows with "IP-0000063409-ABC" and "123-IP-0000063409"?
Thanks,
Angus

 

[Trebor76]

Hi Angus,

What column are you checking for the IP text?

Robert

 

[Angus_Sinclair]

Hi,
Sorry my file is a different file, but this was the closest thing I could find to explain this. In my file I need to keep the rows where column H contains 3351, but sometimes its "3351" and other times its "3351/XXX" where the xxx can be anything. I need to keep both these, any delete any rows that don't have any form of "3351" within the column H cell.

 

[Trebor76]

OK, you're request is simpler then.

Try this (initially on a copy of your data in as the results cannot be undone if they're not as expected) while on the worksheet with the data:

Option Explicit
Sub Macro2()

    Const lngStartRow As Long = 2 'Starting row number for your data. Change to suit.
    
    Dim lngMyCol As Long, _
        lngLastRow As Long
    Dim xlnCalcMethod As XlCalculation
    Dim varDelItem As Variant
            
    With Application
        xlnCalcMethod = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    varDelItem = 3351 'If this item is not found within the text of Col. H, that row(s) will be deleted. Change to suit.
    lngMyCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    With Columns(lngMyCol)
        With Range(Cells(lngStartRow, lngMyCol), Cells(lngLastRow, lngMyCol))
            .Formula = "=IF(ISERROR(SEARCH(""" & varDelItem & """,H" & lngStartRow & ")),NA(),"""")"
            .Calculate
            .Value = .Value
        End With
        On Error Resume Next 'Turn error reporting off - OK to ignore 'No cells found' message
            .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
        On Error GoTo 0 'Turn error reporting back on
        .Delete
    End With
    
    With Application
        .Calculation = xlnCalcMethod
        .ScreenUpdating = True
    End With

    MsgBox "All entries in Col. H not containing """ & varDelItem & """ have now been deleted.", vbInformation

End Sub

Regards,

Robert