logic2design
7/29/2013 - 1:10 AM

This will wipe the row if specified text is not found in a particular column

This will wipe the row if specified text is not found in a particular column

Public Function GetLastRow(ByVal rngToCheck As Range) As Long

    Dim rngLast As Range
    
    Set rngLast = rngToCheck.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious)
    
    If rngLast Is Nothing Then
        GetLastRow = rngToCheck.Row
    Else
        GetLastRow = rngLast.Row
    End If
    
End Function


Sub IWIE()

    Dim varList As Variant
    Dim lngLastRow As Long, lngCounter As Long
    Dim rngToCheck As Range, rngFound As Range
    Dim rngToDelete As Range, rngDifferences As Range
    Dim blnFound As Boolean
    
    Application.ScreenUpdating = False
    
    With Sheet2
        lngLastRow = GetLastRow(.Cells)
        
        'we don't want to delete our header row
        Set rngToCheck = .Range("C2:C" & lngLastRow)
    End With
    
    If lngLastRow > 1 Then
        
        With rngToCheck
            
            varList = VBA.Array("text1", "text2", "text3")
            
            For lngCounter = LBound(varList) To UBound(varList)
 
                Set rngFound = .Find( _
                                        what:=varList(lngCounter), _
                                        Lookat:=xlWhole, _
                                        searchorder:=xlByRows, _
                                        searchdirection:=xlNext, _
                                        MatchCase:=True)
 
                'check if we found a value we want to keep
                If Not rngFound Is Nothing Then
                
                    blnFound = True
                    
                    'if there are no cells with a different value then
                    'we will get an error
                    On Error Resume Next
                    Set rngDifferences = .ColumnDifferences(Comparison:=rngFound)
                    On Error GoTo 0
                        
                    If Not rngDifferences Is Nothing Then
                        If rngToDelete Is Nothing Then
                            Set rngToDelete = rngDifferences
                        Else
                            Set rngToDelete = Application.Intersect(rngToDelete, rngDifferences)
                        End If
                    End If
 
                End If
                 
            Next lngCounter
        End With
            
        If rngToDelete Is Nothing Then
            If Not blnFound Then rngToCheck.EntireRow.Delete
        Else
            rngToDelete.EntireRow.Delete
        End If
    End If
 
    Application.ScreenUpdating = True
    
End Sub