VBA - Application.Match problem

[cfdh_edmundo]

Hi,

I am trying to write a macro which cycles through column B (after row 7) of my ("Macro_Summary") sheet and deletes the entire row if the cell in column B doesn't contain one of the following names:


The names should be on an exact match basis (i.e. "Jerry" would pass, but "Je_rry", "Jerry 12" and "Jerry_3" would not pass and be deleted)

It should also delete the cell if it is blank or empty.


I thought the most efficient way to do this would be via a declared array and a match function based on that.

I've written the code below, it deletes some of the row where column B doesn't pass, but it also keeps some cells where there is no match in column B.

I think either the Application.Match function is not exact (and so doesn't strip out enough rows) or there is a problem with my [For Each...Next] loop.

I also added in the [ ElseIf Len(cell.Value) = 0 Then cell.EntireRow.Delete ] section of code to see if it would at least strip out all the empty cells, but again it doesn't remove every empty row. And in any case the Application.Match should delete blanks anyway (since there are no blanks in my array).

If anyone could take a look and see where I'm going wrong that would be great.

Many thanks!

Sub Test()

 Sheets("Macro_Summary").Select
 Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

 
Dim myArr() As String
myArr = Split("Barry,Gary,Harry,Sally,Charlie,Victor,Larry,Terry,Jerry,Kerry,Danny", ",")


Set dltRange = Range("B7:B1000")
    For Each cell In dltRange
        If IsError(Application.Match(cell.Value, myArr, 0)) Then
        'If cell.Value <> 0 Then
            cell.EntireRow.Delete
        ElseIf Len(cell.Value) = 0 Then
            cell.EntireRow.Delete
        End If
    Next


End Sub

 

[Norie]

Try looping backwards.

Sub Test()
Dim cell As Range
Dim myArr() As String
Dim I As Long

    myArr = Split("Barry,Gary,Harry,Sally,Charlie,Victor,Larry,Terry,Jerry,Kerry,Danny", ",")
    
    With Sheets("Macro_Summary")
            .Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
        For I = 1000 To 7 Step -1
            
            Set cell = .Range("B" & I)
        
            If IsError(Application.Match(cell.Value, myArr, 0)) Then
                cell.EntireRow.Delete
            ElseIf Len(cell.Value) = 0 Then
                cell.EntireRow.Delete
            End If
            
        Next I
        
    End With

End Sub

 

[steve the fish]

You need to work from the bottom up when deleting rows. So

For i = 1000 to 7 Step -1

then use eg,

Range("B" & i).Value

 

[Fluff]

Another option

Sub Test()
   Dim myArr() As String
   Dim cell As Range

   With Sheets("Pcode")
      .Range("B7:B1000").Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder _
         :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

      myArr = Split("Barry,Gary,Harry,Sally,Charlie,Victor,Larry,Terry,Jerry,Kerry,Danny", ",")
    
      For Each cell In .Range("B7:B1000")
         If Not UBound(Filter(myArr, cell.Value, True, vbTextCompare)) >= 0 Then cell.Value = ""
      Next cell
      .Range("B7:B1000").SpecialCells(xlBlanks).EntireRow.Delete
   End With
End Sub

This will not work if you have formulas in col B

 

[cfdh_edmundo]

Works a treat! - Thanks very much!