Sub DelColH()
LastRowNum = Cells.SpecialCells(xlCellTypeLastCell).Row
ReadRow = 1
For n = 1 to LastRowNum
If Range("H" & ReadRow).Value = "%" Or _
Range("H" & ReadRow).Value = "Resistor" Or _
Range("H" & ReadRow).Value = "Capacitor" Or _
Range("H" & ReadRow).Value = "MCKT" Or _
'Add similar lines here for anything else that you want to delete. Last line must end with Then, not Or _.
Range("H" & ReadRow).Value = "Connector" Then
Range("H" & ReadRow).EntireRow.Delete
Else
ReadRow = ReadRow + 1
End If
Next
End Sub
I'm assuming that you're looking for exact matches (i.e. not the specified word in the middle of a sentence)? If so, try this macro, adding any extra lines you need where marked:
Code:Sub DelColH() LastRowNum = Cells.SpecialCells(xlCellTypeLastCell).Row ReadRow = 1 For n = 1 to LastRowNum If Range("H" & ReadRow).Value = "%" Or _ Range("H" & ReadRow).Value = "Resistor" Or _ Range("H" & ReadRow).Value = "Capacitor" Or _ Range("H" & ReadRow).Value = "MCKT" Or _ 'Add similar lines here for anything else that you want to delete. Last line must end with Then, not Or _. Range("H" & ReadRow).Value = "Connector" Then Range("H" & ReadRow).EntireRow.Delete Else ReadRow = ReadRow + 1 End If Next End Sub
Sub DelColH()
Option Compare Text
LastRowNum = Cells.SpecialCells(xlCellTypeLastCell).Row
ReadRow = 1
For n = 1 to LastRowNum
If Range("H" & ReadRow).Value Like "*%*" = True Or _
Range("H" & ReadRow).Value Like "*Resistor*" = True Or _
Range("H" & ReadRow).Value Like "*Capacitor*" = True Or _
Range("H" & ReadRow).Value Like "*MCKT*" = True Or _
'Add similar lines here for anything else that you want to delete. Last line must end with Then, not Or _.
Range("H" & ReadRow).Value Like "*Connector*" = True Then
Range("H" & ReadRow).EntireRow.Delete
Else
ReadRow = ReadRow + 1
End If
Next
End Sub
Amended code is then:
This macro is not case sensitive. If you want it to be case sensitive, remove the Option Compare Text line.Code:Sub DelColH() Option Compare Text LastRowNum = Cells.SpecialCells(xlCellTypeLastCell).Row ReadRow = 1 For n = 1 to LastRowNum If Range("H" & ReadRow).Value Like "*%*" = True Or _ Range("H" & ReadRow).Value Like "*Resistor*" = True Or _ Range("H" & ReadRow).Value Like "*Capacitor*" = True Or _ Range("H" & ReadRow).Value Like "*MCKT*" = True Or _ 'Add similar lines here for anything else that you want to delete. Last line must end with Then, not Or _. Range("H" & ReadRow).Value Like "*Connector*" = True Then Range("H" & ReadRow).EntireRow.Delete Else ReadRow = ReadRow + 1 End If Next End Sub
It will also find/delete where the text is part of a longer word - e.g. "connector" will find and delete "connectors".
If you have a lot of entries to go through, I would recommend storing them in an array, and looping through that array.
Sub DelColH()
Dim V As Variant, DeleteMe As Variant
DeleteMe = Array("%", "Resistor", "Capacitor", "MCKT", "Connector")
For Each V In DeleteMe
Columns("H").Replace "*" & V & "*", "#N/A", xlWhole, , True, False, False
Next
On Error Resume Next
Columns("H").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
On Error GoTo 0
End Sub
Here is another macro that you can consider (add any new items to the comma delimited quoted list that I show in blue below)...
Rich (BB code):Sub DelColH() Dim V As Variant, DeleteMe As Variant DeleteMe = Array("%", "Resistor", "Capacitor", "MCKT", "Connector") For Each V In DeleteMe Columns("H").Replace "*" & V & "*", "#N/A", xlWhole, , True, False, False Next On Error Resume Next Columns("H").SpecialCells(xlConstants, xlErrors).EntireRow.Delete On Error GoTo 0 End Sub