CODEWITHSUNDEEP
excelvba
Todd
Todd

Reputation: 131

VBA Find specific text in Range, Delete row

I am using the below code in a file which I have multiple values (i.e. DWG, _MS, _AN, _NAS, AND _PKG) that I am trying to delete the rows if present. Is there a way to use this code to find all of these values at once and delete the rows instead of doing this code for each value. The each value works, but just trying to make it cleaner and hopefully faster since the individual value code takes a will to execute on a large excel file.

 On Error Resume Next
 With Columns("K")
     .Replace "*DWG*", "=1", xlWhole
     .SpecialCells(xlFormulas).EntireRow.Delete
 End With
 On Error Resume Next
 With Columns("K")
     .Replace "*_MS*", "=1", xlWhole
     .SpecialCells(xlFormulas).EntireRow.Delete
 End With
 On Error Resume Next
 With Columns("K")
     .Replace "*_AN*", "=1", xlWhole
     .SpecialCells(xlFormulas).EntireRow.Delete
 End With
 On Error Resume Next
 With Columns("K")
     .Replace "*_NAS*", "=1", xlWhole
     .SpecialCells(xlFormulas).EntireRow.Delete
 End With
 On Error Resume Next
 With Columns("K")
     .Replace "*_PKG*", "=1", xlWhole
     .SpecialCells(xlFormulas).EntireRow.Delete
 End With

Upvotes: 0

Views: 740

Answers (2)

BruceWayne
BruceWayne

Reputation: 23285

In addition to Excel Hero's answer, you can use an array to store your find/replace strings and then loop through it:

Sub test()
Dim myStrings() As Variant
Dim i&
myStrings() = Array("*DWG*", "*_MS*", "*_AN*", "*_NAS*", "*_PKG*")

On Error Resume Next
With Columns("K")
    For i = 0 To UBound(myStrings)
        .Replace myStrings(i), "=1", xlWhole
    Next i
    .SpecialCells(xlFormulas).EntireRow.Delete
End With
End Sub

So, in the future if you want to add/remove strings, just alter the myStrings() array, in one place, and you're good to go.

Upvotes: 3

Excel Hero
Excel Hero

Reputation: 14764

Try this:

With Columns("K")
    .Replace "*DWG*", "=1", xlWhole
    .Replace "*_MS*", "=1", xlWhole
    .Replace "*_AN*", "=1", xlWhole
    .Replace "*_NAS*", "=1", xlWhole
    .Replace "*_PKG*", "=1", xlWhole
    .SpecialCells(xlFormulas).EntireRow.Delete
End With

Upvotes: 3

Related Questions