G
gedkins
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
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