Combine Code

[Steph]

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 code 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"), 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

 

[Bernie Deitrick]

Steph,

Try the code below. It does the row deletion all at once based on a
sort, which is much quicker than deleting row by row. Also, it
deletes the rows immediately after opening and copying the file, so
the file size should never be too big. My assumption was that you
were looking for entire cell values when you were searching for logon
logoff timeout, so if that is incorrect, the formula used for the sort
will need to be changed.

HTH,
Bernie
MS Excel MVP

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)
DelRowsFinal
'Note: Thisworkbook refers to the workbook the macro is
runningfrom
wkbk.Close

Next
End If
End Sub

'Code 2
Sub DelRowsFinal()
Range("A1").EntireColumn.Insert
Range("A1").FormulaR1C1 = _
"=IF(OR(RC[4]=""logoff""," & _
"RC[4]=""timeout""," & _
"RC[4]=""logon""),""Trash"",""Keep"")"
Range("A1").Copy Range("A1:A" &
Range("E1").CurrentRegion.Rows.Count)
With Range(Range("A1"), Range("A1").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A1")).Select
Range(Selection, Range("A65536").End(xlUp)).EntireRow.Delete
Range("A1").EntireColumn.Delete
End Sub

 

[Bernie Deitrick]

Ooops,

In the first macro, the line:
DelRowsFinal
should go after the line:
wkbk.Close

Sorry about that.

Bernie
MS Excel MVP

Steph,

Try the code below. It does the row deletion all at once based on a
sort, which is much quicker than deleting row by row. Also, it
deletes the rows immediately after opening and copying the file, so
the file size should never be too big. My assumption was that you
were looking for entire cell values when you were searching for logon
logoff timeout, so if that is incorrect, the formula used for the sort
will need to be changed.

HTH,
Bernie
MS Excel MVP

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)
DelRowsFinal
'Note: Thisworkbook refers to the workbook the macro is
runningfrom
wkbk.Close

Next
End If
End Sub

'Code 2
Sub DelRowsFinal()
Range("A1").EntireColumn.Insert
Range("A1").FormulaR1C1 = _
"=IF(OR(RC[4]=""logoff""," & _
"RC[4]=""timeout""," & _
"RC[4]=""logon""),""Trash"",""Keep"")"
Range("A1").Copy Range("A1:A" &
Range("E1").CurrentRegion.Rows.Count)
With Range(Range("A1"), Range("A1").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A1")).Select
Range(Selection, Range("A65536").End(xlUp)).EntireRow.Delete
Range("A1").EntireColumn.Delete
End Sub

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 code 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"), 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