Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 312
Default Combine Code

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: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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,441
Default Combine Code

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


"Steph" wrote in message
om...
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: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



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,441
Default Combine Code

Ooops,

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

Sorry about that.

Bernie
MS Excel MVP

"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
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


"Steph" wrote in message
om...
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: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





Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
split post code (zip code) out of cell that includes full address Concord Excel Discussion (Misc queries) 4 October 15th 09 06:59 PM
How do I combine worksheets w/o enough rows to combine? Amanda W. Excel Worksheet Functions 3 June 9th 09 07:26 AM
Combine cells with the same reference and combine quantities brandon Excel Discussion (Misc queries) 2 September 17th 08 05:44 PM
Drop Down/List w/Code and Definition, only code entered when selec Spiritdancer Excel Worksheet Functions 2 November 2nd 07 03:57 AM
Combine Worksheets - help with Code! CherylH Excel Discussion (Misc queries) 1 September 13th 07 03:45 PM


All times are GMT +1. The time now is 12:25 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"