Delete EEE Parts from Excel File

CC268

Active Member
Joined
Mar 7, 2016
Messages
328
Hello,

I'd like to come up with some VBA Code that will look up the following keywords in Columns E and I of my Excel file and delete those rows:

  • Jans (this keyword needs to be searched in Column G only)
  • Resistor
  • %
  • Diode
  • Trans
  • MCKT
  • Micro
  • Conn
  • Relay
  • Inductor

Thanks
 
What happens when you attempt to execute the line that selects the rows? Do you get an error? If yes, what's the error message? If not, are you certain you haven't clicked on a cell or done something to deselect the rows?

The code all works until the line:

Code:
Range("E:I").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete

It goes through, finds the keywords, and replaces those with #N/A. However, the line above throws the error: "Run-time error '1004': No cells were found."

It won't delete anything or select anything if I change .Delete to .Select. I don't click on anything after running the code so I haven't deselected anything as far as I know.
 
Last edited:
Upvote 0

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Tried this as well - gets rid of the error, but won't delete the rows:

Code:
On Error Resume Next
Range("E:I").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
On Error GoTo 0
 
Last edited:
Upvote 0
I think I see what is going on here...I need it to find the string "#N/A", not the error "#N/A". Just not sure how to modify to do so.
 
Upvote 0
Oops, I forgot you had indicated in post #3 that the keywords could be embedded in longer strings. So the current code is simply replacing only the keyword with "#N/A", leaving the rest of the string intact - not what you want. Here's a revision that uses the find method that should work for you.
Code:
Sub CC268()
Dim Wrds As Variant, Gwrd As String, i As Long, Fnd As Range, fAdr As String
Gwrd = "Jans"
Wrds = Array("ohm", "resistor", "MCKT", "micro", "inductor")
Application.ScreenUpdating = False
Set Fnd = Range("G:G").Find(Gwrd, , , xlPart, , , False)
If Not Fnd Is Nothing Then
    fAdr = Fnd.Address
    Fnd.Value = "#N/A"
    Do
        Set Fnd = Range("G:G").FindNext(Fnd)
        If Fnd Is Nothing Then Exit Do
        If Fnd.Address = fAdr Then Exit Do
        Fnd.Value = "#N/A"
    Loop
End If
For i = LBound(Wrds) To UBound(Wrds)
    Set Fnd = Range("E:E").Find(Wrds(i), , , xlPart, , , False)
    If Not Fnd Is Nothing Then
        fAdr = Fnd.Address
        Fnd.Value = "#N/A"
        Do
            Set Fnd = Range("E:E").FindNext(Fnd)
            If Fnd Is Nothing Then Exit Do
            If Fnd.Address = fAdr Then Exit Do
            Fnd.Value = "#N/A"
        Loop
    End If
    Set Fnd = Range("I:I").Find(Wrds(i), , , xlPart, , , False)
    If Not Fnd Is Nothing Then
        fAdr = Fnd.Address
        Fnd.Value = "#N/A"
        Do
            Set Fnd = Range("I:I").FindNext(Fnd)
            If Fnd Is Nothing Then Exit Do
            If Fnd.Address = fAdr Then Exit Do
            Fnd.Value = "#N/A"
        Loop
    End If
Next i
Range("E:I").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.delete
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Oops, I forgot you had indicated in post #3 that the keywords could be embedded in longer strings. So the current code is simply replacing only the keyword with "#N/A", leaving the rest of the string intact - not what you want. Here's a revision that uses the find method that should work for you.
Code:
Sub CC268()
Dim Wrds As Variant, Gwrd As String, i As Long, Fnd As Range, fAdr As String
Gwrd = "Jans"
Wrds = Array("ohm", "resistor", "MCKT", "micro", "inductor")
Application.ScreenUpdating = False
Set Fnd = Range("G:G").Find(Gwrd, , , xlPart, , , False)
If Not Fnd Is Nothing Then
    fAdr = Fnd.Address
    Fnd.Value = "#N/A"
    Do
        Set Fnd = Range("G:G").FindNext(Fnd)
        If Fnd Is Nothing Then Exit Do
        If Fnd.Address = fAdr Then Exit Do
        Fnd.Value = "#N/A"
    Loop
End If
For i = LBound(Wrds) To UBound(Wrds)
    Set Fnd = Range("E:E").Find(Wrds(i), , , xlPart, , , False)
    If Not Fnd Is Nothing Then
        fAdr = Fnd.Address
        Fnd.Value = "#N/A"
        Do
            Set Fnd = Range("E:E").FindNext(Fnd)
            If Fnd Is Nothing Then Exit Do
            If Fnd.Address = fAdr Then Exit Do
            Fnd.Value = "#N/A"
        Loop
    End If
    Set Fnd = Range("I:I").Find(Wrds(i), , , xlPart, , , False)
    If Not Fnd Is Nothing Then
        fAdr = Fnd.Address
        Fnd.Value = "#N/A"
        Do
            Set Fnd = Range("I:I").FindNext(Fnd)
            If Fnd Is Nothing Then Exit Do
            If Fnd.Address = fAdr Then Exit Do
            Fnd.Value = "#N/A"
        Loop
    End If
Next i
Range("E:I").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.delete
Application.ScreenUpdating = True
End Sub

Thanks a ton! That seems to work!
 
Upvote 0
Oops, I forgot you had indicated in post #3 that the keywords could be embedded in longer strings. So the current code is simply replacing only the keyword with "#N/A", leaving the rest of the string intact - not what you want. Here's a revision that uses the find method that should work for you.
Code:
Sub CC268()
Dim Wrds As Variant, Gwrd As String, i As Long, Fnd As Range, fAdr As String
Gwrd = "Jans"
Wrds = Array("ohm", "resistor", "MCKT", "micro", "inductor")
Application.ScreenUpdating = False
Set Fnd = Range("G:G").Find(Gwrd, , , xlPart, , , False)
If Not Fnd Is Nothing Then
    fAdr = Fnd.Address
    Fnd.Value = "#N/A"
    Do
        Set Fnd = Range("G:G").FindNext(Fnd)
        If Fnd Is Nothing Then Exit Do
        If Fnd.Address = fAdr Then Exit Do
        Fnd.Value = "#N/A"
    Loop
End If
For i = LBound(Wrds) To UBound(Wrds)
    Set Fnd = Range("E:E").Find(Wrds(i), , , xlPart, , , False)
    If Not Fnd Is Nothing Then
        fAdr = Fnd.Address
        Fnd.Value = "#N/A"
        Do
            Set Fnd = Range("E:E").FindNext(Fnd)
            If Fnd Is Nothing Then Exit Do
            If Fnd.Address = fAdr Then Exit Do
            Fnd.Value = "#N/A"
        Loop
    End If
    Set Fnd = Range("I:I").Find(Wrds(i), , , xlPart, , , False)
    If Not Fnd Is Nothing Then
        fAdr = Fnd.Address
        Fnd.Value = "#N/A"
        Do
            Set Fnd = Range("I:I").FindNext(Fnd)
            If Fnd Is Nothing Then Exit Do
            If Fnd.Address = fAdr Then Exit Do
            Fnd.Value = "#N/A"
        Loop
    End If
Next i
Range("E:I").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.delete
Application.ScreenUpdating = True
End Sub

I wanted to add some additional keywords to the G column so I modified the code. It appears to work, but I get an error on the last line and it states, ""Run-time error '1004': Cannot use that command on overlapping selections."

Code:
Sub Delete_EEE()

Dim Wrds As Variant, Gwrds As Variant, i As Long, Fnd As Range, fAdr As String


Gwrds = Array("jan", "m123", "06014", "06015", "06016", "t49", "m39", "cwr", "64002169", "rnc", "d55", "rer", "rlr", "rwr", "M55", "5962")


Wrds = Array("ohm", "resistor", "semiconductor", "MCKT", "MICKT", "microcircuit", "inductor", "xfmr", "eeprom", "oscillator")


'Application.ScreenUpdating = False


For i = LBound(Gwrds) To UBound(Gwrds)
    Set Fnd = Range("G:G").Find(Gwrds(i), , , xlPart, , , False)
    If Not Fnd Is Nothing Then
        fAdr = Fnd.Address
        Fnd.Value = "#N/A"
        Do
            Set Fnd = Range("G:G").FindNext(Fnd)
            If Fnd Is Nothing Then Exit Do
            If Fnd.Address = fAdr Then Exit Do
            Fnd.Value = "#N/A"
        Loop
    End If
Next i


For i = LBound(Wrds) To UBound(Wrds)
    Set Fnd = Range("E:E").Find(Wrds(i), , , xlPart, , , False)
    If Not Fnd Is Nothing Then
        fAdr = Fnd.Address
        Fnd.Value = "#N/A"
        Do
            Set Fnd = Range("E:E").FindNext(Fnd)
            If Fnd Is Nothing Then Exit Do
            If Fnd.Address = fAdr Then Exit Do
            Fnd.Value = "#N/A"
        Loop
    End If
    Set Fnd = Range("I:I").Find(Wrds(i), , , xlPart, , , False)
    If Not Fnd Is Nothing Then
        fAdr = Fnd.Address
        Fnd.Value = "#N/A"
        Do
            Set Fnd = Range("I:I").FindNext(Fnd)
            If Fnd Is Nothing Then Exit Do
            If Fnd.Address = fAdr Then Exit Do
            Fnd.Value = "#N/A"
        Loop
    End If
Next i


Range("E:I").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete


'Application.ScreenUpdating = True



End Sub

 
Last edited:
Upvote 0
Now you have so many keywords that some rows have more than one keyword in columns E:I. That means there are multiple range areas on at least one row - i.e. overlapping selections. I'd be inclined to address one column at a time like this:
Code:
Sub Delete_EEE()
Dim Wrds As Variant, Gwrds As Variant, i As Long, Fnd As Range, fAdr As String
Gwrds = Array("jan", "m123", "06014", "06015", "06016", "t49", "m39", "cwr", "64002169", "rnc", "d55", "rer", "rlr", "rwr", "M55", "5962")
Wrds = Array("ohm", "resistor", "semiconductor", "MCKT", "MICKT", "microcircuit", "inductor", "xfmr", "eeprom", "oscillator")
Application.ScreenUpdating = False
For i = LBound(Gwrds) To UBound(Gwrds)
    Set Fnd = Range("G:G").Find(Gwrds(i), , , xlPart, , , False)
    If Not Fnd Is Nothing Then
        fAdr = Fnd.Address
        Fnd.Value = "#N/A"
        Do
            Set Fnd = Range("G:G").FindNext(Fnd)
            If Fnd Is Nothing Then Exit Do
            If Fnd.Address = fAdr Then Exit Do
            Fnd.Value = "#N/A"
        Loop
    End If
Next i
On Error Resume Next
Range("G:G").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
On Error GoTo 0
For i = LBound(Wrds) To UBound(Wrds)
    Set Fnd = Range("E:E").Find(Wrds(i), , , xlPart, , , False)
    If Not Fnd Is Nothing Then
        fAdr = Fnd.Address
        Fnd.Value = "#N/A"
        Do
            Set Fnd = Range("E:E").FindNext(Fnd)
            If Fnd Is Nothing Then Exit Do
            If Fnd.Address = fAdr Then Exit Do
            Fnd.Value = "#N/A"
        Loop
    End If
Next i
On Error Resume Next
Range("E:E").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
On Error GoTo 0
For i = LBound(Wrds) To UBound(Wrds)
    Set Fnd = Range("I:I").Find(Wrds(i), , , xlPart, , , False)
    If Not Fnd Is Nothing Then
        fAdr = Fnd.Address
        Fnd.Value = "#N/A"
        Do
            Set Fnd = Range("I:I").FindNext(Fnd)
            If Fnd Is Nothing Then Exit Do
            If Fnd.Address = fAdr Then Exit Do
            Fnd.Value = "#N/A"
        Loop
    End If
Next i
On Error Resume Next
Range("I:I").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Since there are only 3 columns, I don't think this will be noticeably slower.
 
Upvote 0
Here's a more compact version that might also be a bit faster.
Code:
Sub DeleteKeyWordsRows()
Dim Ar As Range
Dim Wrds As Variant, Gwrds As Variant, i As Long, Fnd As Range, fAdr As String
Gwrds = Array("jan", "m123", "06014", "06015", "06016", "t49", "m39", "cwr", "64002169", "rnc", "d55", "rer", "rlr", "rwr", "M55", "5962")
Wrds = Array("ohm", "resistor", "semiconductor", "MCKT", "MICKT", "microcircuit", "inductor", "xfmr", "eeprom", "oscillator")
Application.ScreenUpdating = False
For i = LBound(Gwrds) To UBound(Gwrds)
    Range("G:G").Replace what:="*" & Gwrds(i) & "*", replacement:="#N/A", lookat:=xlPart, MatchCase:=False
Next i
For i = LBound(Wrds) To UBound(Wrds)
    Range("E:E").Replace what:="*" & Wrds(i) & "*", replacement:="#N/A", lookat:=xlPart, MatchCase:=False
    Range("I:I").Replace what:="*" & Wrds(i) & "*", replacement:="#N/A", lookat:=xlPart, MatchCase:=False
Next i
On Error Resume Next
For Each Ar In Range("E:I").SpecialCells(xlCellTypeConstants, xlErrors).Areas
    Ar.EntireRow.Delete
Next Ar
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Here's a more compact version that might also be a bit faster.
Code:
Sub DeleteKeyWordsRows()
Dim Ar As Range
Dim Wrds As Variant, Gwrds As Variant, i As Long, Fnd As Range, fAdr As String
Gwrds = Array("jan", "m123", "06014", "06015", "06016", "t49", "m39", "cwr", "64002169", "rnc", "d55", "rer", "rlr", "rwr", "M55", "5962")
Wrds = Array("ohm", "resistor", "semiconductor", "MCKT", "MICKT", "microcircuit", "inductor", "xfmr", "eeprom", "oscillator")
Application.ScreenUpdating = False
For i = LBound(Gwrds) To UBound(Gwrds)
    Range("G:G").Replace what:="*" & Gwrds(i) & "*", replacement:="#N/A", lookat:=xlPart, MatchCase:=False
Next i
For i = LBound(Wrds) To UBound(Wrds)
    Range("E:E").Replace what:="*" & Wrds(i) & "*", replacement:="#N/A", lookat:=xlPart, MatchCase:=False
    Range("I:I").Replace what:="*" & Wrds(i) & "*", replacement:="#N/A", lookat:=xlPart, MatchCase:=False
Next i
On Error Resume Next
For Each Ar In Range("E:I").SpecialCells(xlCellTypeConstants, xlErrors).Areas
    Ar.EntireRow.Delete
Next Ar
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Appears to work perfectly! Thanks!
 
Upvote 0

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

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