Combine 2 macros
 

Hi. Thanks to all of you, I know have 2 pieces of code that (at least
thoretically) do exactly what I need done. The problem is with the
size of the files, and available memory. I ran the code on my boss's
dual-processor workstation, and it still crashed.

Code 1 opens up several text files and pastes them into a separate
worksheet within 1 workbook. Each sheet has approx 40k rows.

Code 2 deletes the lines on each sheet that do not contain the words
'login' or 'logoff' or 'timeout'.

So that being said, maybe the ode will run faster if I combine the 2
modules into one loop. So instead of opening ALL files and pasting
them into one workbook, and THEN deleting unnecessary rows, can we
bring in one file, copy that one file into a worksheet, delete the
unnecesary rows, and then bring in the second file.....etc.

This way the workbook never gets too huge. Can you help me combine
the 2 pieces of code? They are below:

Code 1
Sub Combine2()
Dim GetFiles As Variant
Dim iFiles As Long
Dim nFiles As Long
Dim wkbk As Workbook

GetFiles = Application.GetOpenFilename _
(FileFilter:="Text Files (*.*),*.*", _
Title:="Select Files To Open", MultiSelect:=True)
If TypeName(GetFiles) = "Boolean" Then
''' GetFiles is False if GetOpenFileName is Canceled
MsgBox "No Files Selected", vbOKOnly, "Nothing Selected"
End
Else
''' GetFiles is Array of Strings (File Names)
''' File names include Path
For iFiles = LBound(GetFiles) To UBound(GetFiles)
Workbooks.OpenText fileName:=GetFiles(iFiles)
Set wkbk = ActiveWorkbook
wkbk.ActiveSheet.Copy After:=ThisWorkbook.Worksheets(1)
'Note: Thisworkbook refers to the workbook the macro is
runningfrom
wkbk.Close

Next
End If
End Sub

Code 2
Sub DelRowsFinal()
Dim x As Long
Dim c As Range


Application.ScreenUpdating = False

For x = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
With Intersect(Range("D:D"), ActiveSheet.UsedRange.Rows(x))
Set c = .Find("logoff", LookIn:=xlValues)
If c Is Nothing Then
Set c = .Find("timeout", LookIn:=xlValues)
If c Is Nothing Then
Set c = .Find("logon", LookIn:=xlValues)
If c Is Nothing Then

.EntireRow.Delete
End If
End If
End If
End With
Next x

Application.ScreenUpdating = True

End Sub

Thank you!!!

Steph