Skip to content

Instantly share code, notes, and snippets.

@ijd65
Created July 29, 2013 01:10
Show Gist options
  • Save ijd65/6101569 to your computer and use it in GitHub Desktop.
Save ijd65/6101569 to your computer and use it in GitHub Desktop.
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment