PDA

View Full Version : [SOLVED] if does not find matched value data with data on cell delete the row



parscon
02-11-2014, 07:12 AM
I have some value : like : Apple , OEM-1 , OEM-10 , ORJ-11

I need a VBA code that check column B to G and if does not find any value (one of them) of above item (Apple , OEM-1 , OEM-10 , ORJ-11) delete the row .

Example : if in one row i have only one of the above item like apple it will not deleted and if i do not have any of them it will delete the row .

Thank you

parscon
02-11-2014, 07:51 AM
I found this VBA code but it inverse that mean if found that value list it will delete the row of them .



Sub Example1()

Dim varList As Variant
Dim lngarrCounter As Long
Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String

Application.ScreenUpdating = False

varList = VBA.Array("Apple", "OEM-1", "OEM-10") 'You will need to change this to reflect your Named range

For lngarrCounter = LBound(varList) To UBound(varList)

With Sheets("Sheet4").UsedRange 'Change the name to the sheet you want to filter
Set rngFound = .Find( _
What:=varList(lngarrCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)

If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address

If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Application.Union(rngToDelete, rngFound)
End If
End If

Set rngFound = .FindNext(After:=rngFound)

Do Until rngFound.Address = strFirstAddress
If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Application.Union(rngToDelete, rngFound)
End If
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Next lngarrCounter

If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

Application.ScreenUpdating = True

End Sub

westconn1
02-13-2014, 02:18 AM
try like

Dim rw As Range, vfnd As Boolean, rwtodelete As Range
varlist = Array("Apple", "OEM-1", "OEM-10", "ORJ-11")
For Each rw In Range("b1:g99").Rows ' change to suit
For Each v In varlist
Set fnd = rw.Find(v)
If Not fnd Is Nothing Then
vfnd = True: Exit For
End If
Next
If Not vfnd Then
If rwtodelete Is Nothing Then
Set rwtodelete = rw
Else: Set rwtodelete = Union(rwtodelete, rw)
End If
End If
vfnd = False
Next
If Not rwtodelete Is Nothing Then rwtodelete.EntireRow.Delete

parscon
02-13-2014, 02:49 AM
Thank you very much but i have some value like UP-OEM-1 and also these items will not be delete , can you modify the code that that also can delete UP-OEM-1 and other like this ?

Thank you very much

westconn1
02-13-2014, 02:55 AM
just add any other to keep values to the varlist array

or change the to the line below, so that it will only keep lines where cell matches exact
Set fnd = rw.Find(v, , , xlWhole)

parscon
02-13-2014, 02:58 AM
No you do not understand , , I want to keep OEM-1 but i do not want to keep UP-OEM-1 , when i run you VBA code it will keep OEM-1 and UP-OEM-1

Hope you understand .

westconn1
02-13-2014, 03:25 AM
change the line as suggested, should solve the problem

parscon
02-13-2014, 05:07 AM
Thank you very much