You can speed up the program by doing the deletes all at once instead
of row by row. Here is how I would do it. This can be done using
instr, autofilter, copy/paste, and deleting columns. This ran for me
in 5 seconds on 45,000 rows. This code assumes that all of your txt
data is in column A. Hope I understood correctly what you are looking
for. Best of luck, PB
Public Sub FindDelete()
Dim x As Long
Dim strCheck As String
Application.ScreenUpdating = False
'Autofilter Header
Rows("1").Insert
Cells(1, 1) = "Autofilter"
'Check
strCheck = "href" 'change for your needs
For x = 2 To fLastRow
If InStr(1, Cells(x, 1), strCheck, 1) = 0 Then
Cells(x, 2) = "X" 'Mark cells
End If
Next x
'Autofilter
Columns("A:B").AutoFilter Field:=2, Criteria1:="=" 'Filter
unmarked cells
Columns("A:A").Copy
Columns("C:C").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:B").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
'Delete Autofilter Header
Rows("1").Delete
Application.ScreenUpdating = True
Cells(1, 1).Select
End Sub
Public Function fLastRow() As Double
'from
http://www.ozgrid.com/VBA/ExcelRanges.htm
fLastRow = 0
If WorksheetFunction.CountA(Cells) 0 Then
'Search for any entry, by searching backwards by Rows.
fLastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
End Function