Delete EEE Parts from Excel File

C

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
 
Sort by date Sort by votes
JoeMo said:
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?
Click to expand...

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

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
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
JoeMo said:
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
Click to expand...

Thanks a ton! That seems to work!
 
Upvote 0
JoeMo said:
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
Click to expand...

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
JoeMo said:
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
Click to expand...

Appears to work perfectly! Thanks!
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Searching multiple occurence of same keyword from text file and saving its output in different Excel worksheets
Replies
5
Views
337
myall_blues
myall_blues
A
  • Question Question
Macros for cleaning excel file
2
Replies
18
Views
829
jolivanes
jolivanes
H
  • Question Question
Advanced Multi VBA - Creating multiple temporary files and attach them to one email on outlook
Replies
2
Views
263
Hayf13
H
B
  • Question Question
Excel VBA Searching Unique Variables to Match against Exported Schedule Files to Determine Date
Replies
1
Views
158
sijpie
sijpie
K
  • Solved
Code to search job id from multiple sources and update main spreadsheet.
2
Replies
10
Views
642
mumps
mumps

Forum statistics

Threads
1,223,903
Messages
6,175,286
Members
452,631
Latest member
a_potato

Share this page

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