[RESOLVED] Help parsing a non-delimited text file

[scoobydoo2004]

I have a text file that I need to export into excel or a comma delimited file. The file consists of a solid string of prices consisting of numbers and decimal points. The only way I can think to break it down is by finding the decimal point in the string advancing 2 digits for the cents(the price is not a fixed length throughout the file) parse it and keep repeating. Also the information represents columnar data,(i.e. there are 7 fields so after each 7th price a new line should be started to build the columns required. I'm sure this is quite simple but I've been away from programming too long for it to click. Any help is appreciated!

[DigiRev]

Are there always 2 digits after the decimal?

[scoobydoo2004]

Yes there are always 2 digits for the cents field. I posted the data file in the original post

[sessi4ml]

I looked at the file. What is the record length? 64, 128, 256, other?
If you know this...no problem

[scoobydoo2004]

The record length is unknown. However the data is taken from a document that is 7 columns across by 150 rows.

[DigiRev]

I can write a parse routine for it but you'll have to wait a bit because I have to reload Visual Basic back onto my computer.

Unless someone else comes up with the code before then.

[sessi4ml]

Is this one row?
3.803.884.004.164.384.454.
This would be 7 colums

[sessi4ml]

maybe
3.80|3.88|4.00|4.16|4.38|4.45|4.

[scoobydoo2004]

Sessi4ml,
your data line;
3.80|3.88|4.00|4.16|4.38|4.45|4.
is correct except for the last column(7). It should read
4.56 instead of (4.). Then the next data (3.84) goes back to column 1 and loops like this until done.
3.84|4.07|4.47|4.54|4.88|5.00|5.30

[leinad31]

prepend "00" to string
split on "." and store in string array
resize a dynamic destination currency array to size ubound(string array) + Iff(len(last string array element)> 2, 1, 0) -1
loop through string array from lbound to ubound - 1
Mid(current string array element, 3) contains whole number, convert to currency and assign to currency array. BTW Mid(str, 3) is reason for prepend of "00"
Left(next array element, 2) contains decimal portion. Convert to num and divide by 100 then add to whole number in currency array.
Special handling for last array element, if len > 2 then theres still one more whole number without decimal point

EDIT: Based this post on 3.80|3.88|4.00|4.16|4.38|4.45|4If decimal points are complete then no special handling or last array element needed. And currency array size is ubound string array - 1

[Merri]

I think I have an idea. How about a generic function for this kind of job?

' in a module
Option Explicit
 
Public Function Clip(ByRef Text As String, ByRef Keyword As String, ByVal CharPadding As Byte) As String()
    Static lngEnd() As Long, strOut() As String
    Dim lngEndUB As Long, lngPos As Long, lngCount As Long
    ' error detection
    If LenB(Text) = 0 Or LenB(Keyword) = 0 Then Exit Function
    ' reserve space
    lngEndUB = 40
    ReDim Preserve lngEnd(lngEndUB)
    ' find first
    lngPos = InStr(Text, Keyword)
    Do Until lngPos < 1
        ' correct end position
        lngPos = lngPos + CharPadding
        ' need more space?
        If lngEndUB < lngCount Then
            lngEndUB = lngEndUB * 2
            ReDim Preserve lngEnd(lngEndUB)
        End If
        ' remember
        lngEnd(lngCount) = lngPos
        ' jump to next
        lngCount = lngCount + 1
        ' find next
        lngPos = InStr(lngPos + 1, Text, Keyword)
    Loop
    ' decrease as we have one too many
    lngCount = lngCount - 1
    ' none?
    If lngCount < 0 Then Exit Function
    ' reserve space for strings
    ReDim Preserve strOut(lngCount)
    ' validate last item is not out of string length
    If lngEnd(lngCount) > Len(Text) Then lngEnd(lngCount) = Len(Text)
    ' get first item
    strOut(0) = Left$(Text, lngEnd(0))
    ' get remaining items
    For lngPos = 1 To lngCount
        ' clip the one we need
        strOut(lngPos) = Mid$(Text, lngEnd(lngPos - 1) + 1, lngEnd(lngPos) - lngEnd(lngPos - 1))
    Next lngPos
    ' return the final string array
    Clip = strOut
End Function

' sample project: add listbox and command button
Private Sub Command1_Click()
    Dim strTest As String, strIn() As String, lngA As Long
    strTest = "3.803.884.004.164.384.45"
    strIn = Clip(strTest, ".", 2)
    For lngA = 0 To UBound(strIn)
        List1.AddItem strIn(lngA)
    Next lngA
End Sub

[DigiRev]

I came up with a quick sub, didn't test it that much but I think it's working. (Cross-checking with the data file is hard on the eyes )

Private Sub LoadData(ByVal FilePath As String, LVObject As Object, ByVal Columns As Integer)
    Dim lonLoop As Long 'Loop counter.
    Dim intCol As Integer 'Current column we're on.
    Dim lonPos As Long 'Current position of decimal.
    Dim lonPrevDotPos As Long 'Previous position of decimal.
    Dim lonNextDotPos As Long 'Decimal position after current decimal.
    Dim intFF As Integer 'File handle.
    Dim strData As String 'File data.
    Dim intRow As Integer 'Current row.
    Dim intPrevRow As Integer 'Previous row.
    Dim strCur As String
    Dim lonStart As Long
    Dim lonEnd As Long
    
    intFF = FreeFile
    
    Open FilePath For Binary Access Read As #intFF
        
        If LOF(intFF) = 0 Then
            Close #intFF
            Exit Sub
        Else
            strData = Space$(LOF(intFF))
            Get #intFF, 1, strData
        End If
    
    Close #intFF
    
    intRow = 1
    lonPos = InStr(1, strData, ".", vbBinaryCompare)
    
    With LVObject
        .ListItems.Clear
        
        'Keep looping while there are still decimals.
        Do While lonPos > 0
            'Increase current column.
            intCol = intCol + 1
            
            If intCol > Columns Then
                intPrevRow = intRow
                intRow = intRow + 1
                intCol = 1
            End If
            
            If lonPrevDotPos = 0 Then
                'We're on the first decimal.
                'Get current value.
                strCur = Mid$(strData, 1, lonPos + 2)
                lonPrevDotPos = lonPos
                lonPos = lonPos + 2
            Else
                
                'This is not the first decimal.
                'Get text from previous decimal + 3
                'to this decimal + 2
                lonStart = lonPrevDotPos + 3
                lonEnd = lonPos + 2
                
                'strCur = Mid$(strData, lonPrevDotPos + 3, (lonPos + 2) + (lonPrevDotPos + 3) - 2)
                strCur = Mid$(strData, lonStart, (lonEnd - lonStart) + 1)
                lonPrevDotPos = lonPos
                lonPos = lonPos + 2
            End If
            
            If Len(strCur) > 0 Then
                
                If intCol = 1 Then
                    .ListItems.Add , , strCur
                Else
                    .ListItems(intRow).ListSubItems.Add , , strCur
                End If
            
            End If
        
            lonPos = InStr(lonPos + 1, strData, ".", vbBinaryCompare)
        Loop
    
    End With
    
    strData = ""
End Sub
 
Private Sub Command1_Click()
    LoadData App.Path & "\data.txt", lvData, 7
End Sub

I also attached a sample project.

[DigiRev]

And of course Merri posts something half the size of mine and probably twice as fast.

[sessi4ml]

Maybe I am wrong, or maybe old school

Dim strData As String
'3.80|3.88|4.00|4.16|4.38|4.45|4.
'is correct except for the last column(7). It should read
'4.56 instead of (4.). Then the next data (3.84) goes back to column 1 and loops like this until done.
'3.84|4.07|4.47|4.54|4.88|5.00|5.30
 
Private Sub Form_Load()
Dim inrStart As Integer: Dim intX As Integer
    strData = "3.803.884.004.164.384.454.563.844.074.474.544.885.005.303.874.264.704.855.225.395.883.984.414.965.175.525.706.264.254.495.205.415.776.016.644.324.685.295.585.966.256.874.574.825.425."
    intStart = 1
    For intStart = 1 To Len(strData)
    intX = InStr(intStart, strData, ".")
     ' x points to the dot
     'start+ dot +2..1+2+2 .. start + x +2
     
    Text1.Text = Text1.Text + Mid(strData, intStart, intX + 3 - intStart) + ","
    a = a + 1: If a = 7 Then a = 0: Text1.Text = Text1.Text + vbCrLf
    intStart = intX + 2
    Next
    
End Sub

My results:

3.80,3.88,4.00,4.16,4.38,4.45,4.56,
3.84,4.07,4.47,4.54,4.88,5.00,5.30,
3.87,4.26,4.70,4.85,5.22,5.39,5.88,
3.98,4.41,4.96,5.17,5.52,5.70,6.26,
4.25,4.49,5.20,5.41,5.77,6.01,6.64,
4.32,4.68,5.29,5.58,5.96,6.25,6.87,
4.57,4.82,5.42,5.,

[leinad31]

Ooops by mistake, thought it was data needed to be converted to numeric for immediate use...
If your just gonna format the string to include comma separators...

Option Explicit
 
Private Sub Form_Load()
   MsgBox Parse("3.803.884.004.164.384.454.563.844.074.474.544.885.005.303.874.264.704.855.225.395.883.98")
End Sub
 
Public Function Parse(ByVal SrcString As String) As String
Dim sarTmp() As String
Dim cnt As Long
 
   sarTmp = Split(SrcString, ".")
   For cnt = 1 To UBound(sarTmp) - 1
      sarTmp(cnt) = Left(sarTmp(cnt), 2) & "," & Mid(sarTmp(cnt), 3)
   Next
   Parse = Join(sarTmp, ".")
End Function

[leinad31]

Maybe I am wrong, or maybe old school

Dim strData As String
'3.80|3.88|4.00|4.16|4.38|4.45|4.
'is correct except for the last column(7). It should read
'4.56 instead of (4.). Then the next data (3.84) goes back to column 1 and loops like this until done.
'3.84|4.07|4.47|4.54|4.88|5.00|5.30
 
Private Sub Form_Load()
Dim inrStart As Integer: Dim intX As Integer
    strData = "3.803.884.004.164.384.454.563.844.074.474.544.885.005.303.874.264.704.855.225.395.883.984.414.965.175.525.706.264.254.495.205.415.776.016.644.324.685.295.585.966.256.874.574.825.425."
    intStart = 1
    For intStart = 1 To Len(strData)
    intX = InStr(intStart, strData, ".")
     ' x points to the dot
     'start+ dot +2..1+2+2 .. start + x +2
     
    Text1.Text = Text1.Text + Mid(strData, intStart, intX + 3 - intStart) + ","
    a = a + 1: If a = 7 Then a = 0: Text1.Text = Text1.Text + vbCrLf
    intStart = intX + 2
    Next
    
End Sub

My results:

Don't do concatentaion for the entire stream... that's slow cause memory has to be repeatedly set aside and assigned for growing stream.

[sessi4ml]

Don't do concatentaion for the entire stream... that's slow cause memory has to be repeatedly set aside and assigned for growing stream.

True, looking at a 5k file , and this is version 1, and I am new this VB stuff
next time I'll be better

[Merri]

And of course Merri posts something half the size of mine and probably twice as fast.

You forgot to mention I coded it in half the time as well!

However, I didn't provide a fully ready to go solution, but hopefully it is a function that'll be of value for atleast someone else reading this thread later on.

[DigiRev]

You forgot to mention I coded it in half the time as well!

Yea, well half that time I was re-installing VB.

[sessi4ml]

Here is a complete solution.
Any questions, just ask.

[sessi4ml]

Scooby, here is the Text to Excel.
Good to hear the code worked
Any questions, just ask.