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

OilEconomist

Active Member
Joined
Dec 26, 2016
Messages
439
Office Version
  1. 2019
Platform
  1. Windows
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).
VBA Code:
If InStr(Cells(i, "C").Value, ArrayPartial, vbCompare) > 0 Then

My full code:

VBA 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
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
The issue here is that the InStr function does not support searching for multiple substrings at once. You'd need to loop. Try:
VBA Code:
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
 
Upvote 1
Solution
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):
VBA Code:
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
 
Upvote 1
The issue here is that the InStr function does not support searching for multiple substrings at once. You'd need to loop. Try:
VBA Code:
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:
VBA Code:
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.
 
Upvote 0
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):
VBA Code:
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.
 
Upvote 0
No worries! If you have some spare some time, give it a try and compare with the "ordinal" solution. 😎
 
Upvote 1
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.
 
Upvote 0

Forum statistics

Threads
1,224,465
Messages
6,178,822
Members
452,881
Latest member
motivationgyan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top