View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
[email protected] acbservices@gmail.com is offline
external usenet poster
 
Posts: 5
Default combining multiple find/replace subs


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