Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
split post code (zip code) out of cell that includes full address | Excel Discussion (Misc queries) | |||
How do I combine worksheets w/o enough rows to combine? | Excel Worksheet Functions | |||
Combine cells with the same reference and combine quantities | Excel Discussion (Misc queries) | |||
Drop Down/List w/Code and Definition, only code entered when selec | Excel Worksheet Functions | |||
Combine Worksheets - help with Code! | Excel Discussion (Misc queries) |