View Single Post
  #14   Report Post  
Posted to microsoft.public.excel.programming
GS[_2_] GS[_2_] is offline
external usenet poster
 
Posts: 3,514
Default Excel VBA help: Text file formatting

Thank you Garry. I have it working. But the excel is not producing
data after 34,000 lines. I believe it is not reading larger text
files completely. How can I change the code to read large text files?


This is memory-dependant! In this case it's better to import the file
in 'blocks' first, then output to the worksheet block by block. (Now
you see why having the original final was important)

You can open the file in Excel directly so the data is on a worksheet
as per your example...


Sub Parse_ScanFile()
' Parses data from a scan file based on specified criteria
Dim sFile$, vData, saDataOut$(), v1, v2
Dim n&, j&, k&, MaxCols&
Dim wksTarget As Worksheet

Const sCriteria$ = "10": Const sColHdrs$ = "RET Time,Value1,Value2"

sFile = Application.GetOpenFilename
If sFile = "False" Then Exit Sub '//user cancels
Workbooks.OpenText Filename:=sFile, Origin:=xlMSDOS, StartRow:=1

'Load the header row
vData = ActiveSheet.UsedRange
ReDim Preserve saDataOut(j): saDataOut(j) = sColHdrs: j = j + 1

'Iterate each block of scan data
For n = 15 To UBound(vData) - 15 Step 15
v1 = Split(vData(n + 1, 1), "= ")
v2 = Split(vData(n + 3, 1), "= ")
If v2(1) = sCriteria Then
For k = 5 To 14
ReDim Preserve saDataOut(j)
saDataOut(j) = v1(1) & "," & vData(n + k, 1): j = j + 1
Next 'k
End If 'v2="10"
Next 'n

'Transfer output data to a 2D 1-based array
vData = saDataOut: Erase saDataOut
MaxCols = UBound(Split(vData(0), ",")) + 1
ReDim saDataOut(1 To UBound(vData) + 1, 1 To MaxCols)
For n = LBound(vData) To UBound(vData)
v1 = Split(vData(n), ",")
For k = LBound(v1) To UBound(v1)
saDataOut(n + 1, k + 1) = v1(k)
Next 'k
Next 'n
'Dump the data
Set wksTarget = Sheets.Add
wksTarget.Cells(1, 1).Resize(UBound(saDataOut), MaxCols) = saDataOut
End Sub

...where there is no need for 'ReadTextFile' since the original file
data is already on Sheets(1). Note that I do not delete Rows(1:14)
(simply as a 'good practice') in order to keep the original file data
intact.

If the memory issue persists then use...


Sub Parse_ScanFile2()
' Parses data from a scan file based on specified criteria
Dim sFile$, v1, v2, n&, k&
Dim lMaxCols&, lMaxRows&, lNextRow&
Dim wksSource As Worksheet, wksTarget As Worksheet

Const sCriteria$ = "10": Const sColHdrs$ = "RET Time,Value1,Value2"

sFile = Application.GetOpenFilename
If sFile = "False" Then Exit Sub '//user cancels

Application.ScreenUpdating = False
Workbooks.OpenText Filename:=sFile, Origin:=xlMSDOS, StartRow:=1

'Get fully qualified refs
Set wksSource = ActiveSheet: Set wksTarget = Sheets.Add
'Place the headers
v1 = Split(sColHdrs, ",")
wksTarget.Cells(1, 1).Resize(1, UBound(v1) + 1) = v1
'Initialize vars
lMaxRows = wksSource.UsedRange.Rows.Count
lMaxCols = wksTarget.UsedRange.Columns.Count

'Parse the data
lNextRow = 2 '//data starts here
For n = 15 To lMaxRows Step 15
If n = lMaxRows Then Exit For
v1 = Split(wksSource.Cells(n + 1, 1), "= ")
v2 = Split(wksSource.Cells(n + 3, 1), "= ")
If v2(1) = sCriteria Then
For k = 5 To 14
With wksTarget.Cells(lNextRow, 1)
.Resize(1, lMaxCols) = _
Split((v1(1) & "," & wksSource.Cells(n + k, 1)), ",")
lNextRow = lNextRow + 1
End With 'wksTarget.Cells(lNextRow, 1)
Next 'k
End If 'v2 = "10"
Next 'n
Application.ScreenUpdating = True
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion