0

Hi i have below code which delete the rows when it finds particular single criteria from multiple sheets i want to modify the code with multiple criteria

Sub DeleteRow_IMPLEMENTATION()

Dim Header As Range
Dim FoundCell As Range
Dim ws As Worksheet
Dim HeaderToFind As String
Dim ValueToFind As String

Application.ScreenUpdating = False
Application.DisplayStatusBar = False


HeaderToFind = "BankName"
ValueToFind = "abcd"

For Each ws In Worksheets

    Set Header = ws.Rows(1).Find(what:=HeaderToFind, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)

    If Not Header Is Nothing Then

        Set FoundCell = ws.Columns(Header.Column).Find(what:=ValueToFind, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)

        Do While Not FoundCell Is Nothing
            ws.Rows(FoundCell.Row).delete
            Set FoundCell = Nothing
            Set FoundCell = ws.Columns(Header.Column).Find(what:=ValueToFind, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
        Loop

    End If

Next ws
Application.ScreenUpdating = True
Application.DisplayStatusBar = True

End Sub

i tried something like below

HeaderToFind = "BankName"
ValueToFind = "abcd,xyz "

when i tried its not working any help is appreciated.

Community
  • 1
  • 1
Kittu
  • 65
  • 1
  • 9

1 Answers1

0

Try setting the value you are trying to find in an array instead of a comma seperated string. then foreach value in the array: set ValueToFind equal to the value, and call this code

HeaderToFind = "BankName"

Dim  targetValues = New String { "abcd", "xyz" }
For Each targetVal In targetValues
    ValueToFind = targetVal

    For Each ws In Worksheets
        ....
    Next ws
Next targetVal

Alternatively, you can check out this: Efficient way to delete entire row if cell doesn't contain '@'

and set the criteria to your array of values

Community
  • 1
  • 1
MBurnham
  • 381
  • 1
  • 9
  • Sub DeleteMatchingCriteria() Dim ws As Worksheet Application.ScreenUpdating = False Dim toDelete As Variant For Each ws In Worksheets ' set the words to delete toDelete = Array("abcd", "xyz") Dim colD As Range Set col = ws.Range("B2:D" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row) With col .AutoFilter Field:=1, Criteria1:=toDelete, Operator:=xlFilterValues .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete End With WS.AutoFilterMode = False End Sub this code is also giving error – Kittu May 11 '17 at 22:28
  • no cells found error at .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.delete for above code – Kittu May 11 '17 at 22:37
  • @Kittu I am guessing you have changed your code, because I don't see that line of code in your original post.... – MBurnham May 11 '17 at 22:47
  • ..yes trying with Sub DeleteMatchingCriteria() Dim ws As Worksheet Application.ScreenUpdating = False Dim toDelete As Variant For Each ws In Worksheets ' set the words to delete toDelete = Array("abcd", "xyz") Dim colD As Range Set col = ws.Range("B2:D" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row) With col .AutoFilter Field:=1, Criteria1:=toDelete, Operator:=xlFilterValues .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete End With WS.AutoFilterMode = False End Sub – Kittu May 11 '17 at 22:48
  • 1
    @Kittu, can you update your question with this code so it is a little more readable? – MBurnham May 11 '17 at 22:52
  • Hi still i am not able to make this code work...can you please paste exact code as per my requirement – Kittu May 12 '17 at 09:12