Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I have a simple routine in an Excel sheet that opens a file sorts and removes
redundant lines and adds values . Then writes a new file txt to disk of the resulting data. I must be using a lot of memory somewhere. Any one see the memory killer? Sub FixTextFile() Application.ScreenUpdating = False Workbooks.OpenText Filename:= _ "\\cesium\drop box\Data_Read Command Line.txt", Origin:=437, _ StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _ , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2), Array(2, 1)), _ TrailingMinusNumbers:=True n = GetListLength Cells.Select Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortTextAsNumbers RemoveDupes ConcatenateColumns ActiveWorkbook.Close False Application.ScreenUpdating = True End Sub Sub RemoveDupes() Dim n As Integer Dim i As Integer On Error GoTo LastLine n = GetListLength For i = n To 1 Step -1 If Cells(i, 1).Value = Cells(i - 1, 1).Value Then Cells(i - 1, 2).Value = Cells(i, 2).Value + Cells(i - 1, 2).Value Rows(i).Select Selection.Delete End If Next LastLine: Exit Sub End Sub Public Function GetListLength() Dim Listlength As Long Cells(1, 1).Select Selection.End(xlDown).Select Listlength = Selection.Row If Listlength = 65536 Then If Cells(1, 1) < "" Then Listlength = 1 Else Listlength = 0 End If End If GetListLength = Listlength End Function Sub ConcatenateColumns() Range("C1").Select ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"","",RC[-1])" n = GetListLength Range("C1:C" & n & "").Select Selection.FillDown Columns("C:C").Select Selection.Copy Range("D1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("A:C").Select Range("C1").Activate Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Range("A1").Select Open "C:\Documents and Settings\gedkins\Desktop\Data_Read Command Line Test.txt" For Output As #1 For i = 1 To n theVal = Cells(i, 1) Print #1, theVal Next Close #1 End Sub |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Does it work once, and then fail on subsequent runs. Or, does it fail the
first time through? If it works once, but not after that. Turn off your computer and wait a minute or two and then fire it up and try running the macros again. HTH, Ryan-- -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "gedkins" wrote: I have a simple routine in an Excel sheet that opens a file sorts and removes redundant lines and adds values . Then writes a new file txt to disk of the resulting data. I must be using a lot of memory somewhere. Any one see the memory killer? Sub FixTextFile() Application.ScreenUpdating = False Workbooks.OpenText Filename:= _ "\\cesium\drop box\Data_Read Command Line.txt", Origin:=437, _ StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _ , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2), Array(2, 1)), _ TrailingMinusNumbers:=True n = GetListLength Cells.Select Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortTextAsNumbers RemoveDupes ConcatenateColumns ActiveWorkbook.Close False Application.ScreenUpdating = True End Sub Sub RemoveDupes() Dim n As Integer Dim i As Integer On Error GoTo LastLine n = GetListLength For i = n To 1 Step -1 If Cells(i, 1).Value = Cells(i - 1, 1).Value Then Cells(i - 1, 2).Value = Cells(i, 2).Value + Cells(i - 1, 2).Value Rows(i).Select Selection.Delete End If Next LastLine: Exit Sub End Sub Public Function GetListLength() Dim Listlength As Long Cells(1, 1).Select Selection.End(xlDown).Select Listlength = Selection.Row If Listlength = 65536 Then If Cells(1, 1) < "" Then Listlength = 1 Else Listlength = 0 End If End If GetListLength = Listlength End Function Sub ConcatenateColumns() Range("C1").Select ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"","",RC[-1])" n = GetListLength Range("C1:C" & n & "").Select Selection.FillDown Columns("C:C").Select Selection.Copy Range("D1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("A:C").Select Range("C1").Activate Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Range("A1").Select Open "C:\Documents and Settings\gedkins\Desktop\Data_Read Command Line Test.txt" For Output As #1 For i = 1 To n theVal = Cells(i, 1) Print #1, theVal Next Close #1 End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Memory Issues with Excel | Excel Programming | |||
Excel Memory Issues | Excel Discussion (Misc queries) | |||
memory issues | Excel Programming | |||
memory issues with Excel | Excel Programming | |||
Memory Issues | Excel Programming |