Out Of Memory Issues
 

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

Out Of Memory Issues
 

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