MS Excel VBA Code to Delete a Row if the Cells Contains a Partial Match for Values Listed in An Array

[OilEconomist]

Hello and thanks in advance. Please let me know if you know how to fix this error.

My objective is to Loop through a column and delete any rows if the cell contains a partial match of values stored in an array.

Currently I am getting the error "Compile error: Type mismatch" on the following line of code specifically "ArrayPartial" (i.e. that's what gets highlighted for the error).

If InStr(Cells(i, "C").Value, ArrayPartial, vbCompare) > 0 Then

My full code:

Sub PartialMatchTest()


    Dim RowLast As Long
    Dim i As Long
    
    Dim ArrayPartial() As Variant
    
    RowLast = Cells(Rows.Count, "C").End(xlUp).Row
    
    ReDim ArrayPartial(1 To 2)
    ArrayPartial(1) = "https"
    ArrayPartial(2) = "TTY"
    
    For i = RowLast To 9 Step -1
        If InStr(Cells(i, "C").Value, ArrayPartial, vbCompare) > 0 Then
            Rows(i).EntireRow.Delete
        End If
    Next i
    
    
End Sub

 

[Cubist]

The issue here is that the InStr function does not support searching for multiple substrings at once. You'd need to loop. Try:

Sub PartialMatchTest()

    Dim RowLast As Long
    Dim i As Long
    Dim j As Long
 
    Dim ArrayPartial() As Variant
 
    RowLast = Cells(Rows.Count, "C").End(xlUp).Row
 
    ReDim ArrayPartial(1 To 2)
    ArrayPartial(1) = "https"
    ArrayPartial(2) = "TTY"
 
    For i = RowLast To 9 Step -1
        For j = LBound(ArrayPartial) To UBound(ArrayPartial)
            If InStr(1, Cells(i, "C").Value, ArrayPartial(j), vbTextCompare) > 0 Then
                Rows(i).EntireRow.Delete
                Exit For ' Exit the inner loop to prevent deleting already deleted rows
            End If
        Next j
    Next i
 
End Sub

 

[Sektor]

The fastest way to delete rows is to use AutoFilter. In the code below we insert formula to determine rows to delete, and, using AutoFilter, delete those rows (all is in comments):

Sub DeleteByCriteria()

  Dim rng As Range
  Dim rng2 As Range
  Dim rng2Data As Range
  Dim rngVisible As Range
 
  '// source column with header
  Set rng = [C1:C20]
  '// insert helper column
  rng.Offset(, 1).EntireColumn.Insert
  '//with header
  Set rng2 = rng.Offset(, 1)
  '// without header
  With rng2
    Set rng2Data = rng2.Offset(1).Resize(.Rows.Count - 1)
  End With
  '// insert formula to determine cells with required text
  '// R1C1 notation is very handy here
  rng2Data.FormulaR1C1 = "=OR(IFERROR(SEARCH(""https"",RC[-1])>0,0),IFERROR(SEARCH(""TTY"",RC[-1])>0,0))"
  '// filter the column
  rng2.AutoFilter Field:=1, Criteria1:=True
  '// try to get visible rows
  '// if no rows were found, nothing will happen
  On Error Resume Next
  Set rngVisible = rng2Data.SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If Not rngVisible Is Nothing Then
    '// if rows are found, delete them
    rngVisible.EntireRow.Delete
  End If
  '//remove filter
  rng2.AutoFilter
  '//delete helper column
  rng2.EntireColumn.Delete

End Sub

 

[OilEconomist]

The issue here is that the InStr function does not support searching for multiple substrings at once. You'd need to loop. Try:

Sub PartialMatchTest()

    Dim RowLast As Long
    Dim i As Long
    Dim j As Long
 
    Dim ArrayPartial() As Variant
 
    RowLast = Cells(Rows.Count, "C").End(xlUp).Row
 
    ReDim ArrayPartial(1 To 2)
    ArrayPartial(1) = "https"
    ArrayPartial(2) = "TTY"
 
    For i = RowLast To 9 Step -1
        For j = LBound(ArrayPartial) To UBound(ArrayPartial)
            If InStr(1, Cells(i, "C").Value, ArrayPartial(j), vbTextCompare) > 0 Then
                Rows(i).EntireRow.Delete
                Exit For ' Exit the inner loop to prevent deleting already deleted rows
            End If
        Next j
    Next i
 
End Sub[/COD
[QUOTE="Cubist, post: 6199277, member: 510899"]
The issue here is that the InStr function does not support searching for multiple substrings at once. You'd need to loop. Try:
[CODE=vba]Sub PartialMatchTest()

    Dim RowLast As Long
    Dim i As Long
    Dim j As Long
 
    Dim ArrayPartial() As Variant
 
    RowLast = Cells(Rows.Count, "C").End(xlUp).Row
 
    ReDim ArrayPartial(1 To 2)
    ArrayPartial(1) = "https"
    ArrayPartial(2) = "TTY"
 
    For i = RowLast To 9 Step -1
        For j = LBound(ArrayPartial) To UBound(ArrayPartial)
            If InStr(1, Cells(i, "C").Value, ArrayPartial(j), vbTextCompare) > 0 Then
                Rows(i).EntireRow.Delete
                Exit For ' Exit the inner loop to prevent deleting already deleted rows
            End If
        Next j
    Next i
 
End Sub

[/QUOTE]

The issue here is that the InStr function does not support searching for multiple substrings at once. You'd need to loop. Try:

Sub PartialMatchTest()

    Dim RowLast As Long
    Dim i As Long
    Dim j As Long
 
    Dim ArrayPartial() As Variant
 
    RowLast = Cells(Rows.Count, "C").End(xlUp).Row
 
    ReDim ArrayPartial(1 To 2)
    ArrayPartial(1) = "https"
    ArrayPartial(2) = "TTY"
 
    For i = RowLast To 9 Step -1
        For j = LBound(ArrayPartial) To UBound(ArrayPartial)
            If InStr(1, Cells(i, "C").Value, ArrayPartial(j), vbTextCompare) > 0 Then
                Rows(i).EntireRow.Delete
                Exit For ' Exit the inner loop to prevent deleting already deleted rows
            End If
        Next j
    Next i
 
End Sub

Thanks! This worked! Thanks for the quick response and explanation.

 

[OilEconomist]

The fastest way to delete rows is to use AutoFilter. In the code below we insert formula to determine rows to delete, and, using AutoFilter, delete those rows (all is in comments):

Sub DeleteByCriteria()

  Dim rng As Range
  Dim rng2 As Range
  Dim rng2Data As Range
  Dim rngVisible As Range
 
  '// source column with header
  Set rng = [C1:C20]
  '// insert helper column
  rng.Offset(, 1).EntireColumn.Insert
  '//with header
  Set rng2 = rng.Offset(, 1)
  '// without header
  With rng2
    Set rng2Data = rng2.Offset(1).Resize(.Rows.Count - 1)
  End With
  '// insert formula to determine cells with required text
  '// R1C1 notation is very handy here
  rng2Data.FormulaR1C1 = "=OR(IFERROR(SEARCH(""https"",RC[-1])>0,0),IFERROR(SEARCH(""TTY"",RC[-1])>0,0))"
  '// filter the column
  rng2.AutoFilter Field:=1, Criteria1:=True
  '// try to get visible rows
  '// if no rows were found, nothing will happen
  On Error Resume Next
  Set rngVisible = rng2Data.SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If Not rngVisible Is Nothing Then
    '// if rows are found, delete them
    rngVisible.EntireRow.Delete
  End If
  '//remove filter
  rng2.AutoFilter
  '//delete helper column
  rng2.EntireColumn.Delete

End Sub

Thanks @Sektor as this also works. Also, thanks for the quick response and an additional solution. I marked @Cubist's response as the solution since it was first and more similar to the code I had.

 

[Sektor]

No worries! If you have some spare some time, give it a try and compare with the "ordinal" solution.

 

[OilEconomist]

No worries! If you have some spare some time, give it a try and compare with the "ordinal" solution.

It worked. The only thing I see is if I need to add more partial matches (i.e. expand what needs to be partially matched). With the array method, I can just add to the array.