Cycle Multiple strings-CodePudding

I am using this macro which works fine but it's not flexible or as fast it should be. Basically I think it's better to add the BanWords in an array and cycle through them and delete rows.

 Sub delete_data(sh As Worksheet, col As String)
    Dim a As Variant, aWords As Variant
    Dim i As Long, j As Long
    Dim BanWords As String
    Dim lastrow As Long
    
    Application.StatusBar = "Deleting Data..."
        
    'Exceptions List
    BanWords = "2019,2020,2021"
    
    sh.Activate
    
    ''Find Last Row
    With sh
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    'Reverse Iteration
    For i = lastrow To 2 Step -1
        If InStr(1, Range(col & i), "2019") <> 0 Then Rows(i).EntireRow.Delete
        If InStr(1, Range(col & i), "2020") <> 0 Then Rows(i).EntireRow.Delete
        If InStr(1, Range(col & i), "2021") <> 0 Then Rows(i).EntireRow.Delete
    Next i
    
    End Sub

CodePudding user response：

This would be faster:

Sub delete_data(sh As Worksheet, col As String)
    
    Dim arr, i As Long
    Dim BanWords As String, rngDel As Range, c As Range, v
    
    BanWords = "2019,2020,2021" 'Exceptions List
    
    arr = Split(BanWords, ",")
    For Each c In sh.Range("A1", sh.Cells(Rows.Count, "A").End(xlUp)).Cells
        v = c.Value
        For i = LBound(arr) To UBound(arr)
            If InStr(v, arr(i)) > 0 Then
                'collect the row
                If rngDel Is Nothing Then
                    Set rngDel = c
                Else
                    Set rngDel = Union(rngDel, c)
                End If
                Exit For
            End If
        Next i
    Next c
    If Not rngDel Is Nothing Then rngDel.EntireRow.Delete 'delete all rows
    
End Sub

CodePudding user response：

ok I ended up using the VBA Split function.

Sub delete_data(sh As Worksheet, col As String)
Dim a As Variant, aWords As Variant
Dim i As Long, j As Long
Dim BanWords As String
Dim lastrow As Long
Dim arrChoices() As String

Application.StatusBar = "Deleting Data..."
    
'Exceptions List
arrChoices = Split("2019,2020,2021", ",")
sh.Activate

''Find Last Row
With sh
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

'Reverse Iteration
For i = lastrow To 2 Step -1
    For j = LBound(arrChoices) To UBound(arrChoices)
        If InStr(1, Range(col & i), arrChoices(j)) <> 0 Then Rows(i).EntireRow.Delete
    Next j
Next i

End Sub