Help With Tab Delimited File-Reading & Rearranging Values

[kimmelsd33]

I am using VB6. I want to read a tab delimited file, and assign each column value into a variable. If the variable is "-999.25", I want to make it a "0". I then want to reassemble the values, and write them to a temp text file. Starting with line 64, I have about 28 columns and x number of rows. Ex: 1000<tab>23.3<t ab>-999.25<tab> etc. The value of -999.25 can be in any column. I need to replace it before it is stored in the variable. I need to rearrange the columns and write to the temp file.

Sub Perform()
Dim depth, fph, mpf, pdc, slide as String
Open "C:\Temp.dat" For Output As #1 'write to this file
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ObjStream = fso.opentextfile("C:\5inchto1inch.las", 1, False, 0)
'delete header
Dim i As Integer
    i = 0
        Do While i < 64 And Not ObjStream.AtEndOfStream
            strLine = ObjStream.Readline
    i = i + 1
    Loop
Do While Not ObjStream.AtEndOfStream
      strLine = TrimAll(ObjStream.Readline)
      YourArray = Split(strLine, vbTab) '***use the tab key to create space
depth = Trim(YourArray(0))
fph = Trim(YourArray(1))
mpf = Trim(YourArray(2))
pdc = Trim(YourArray(3))
slide = Trim(YourArray(4))
'rearrange and write to temp file
Print #1, mpf & vbTab & pdc & vbTab & depth & vbTab & fph
Loop
Close #1
End Sub
Function TrimAll(Str)
'***remove all non ASCI chrs and reduce internal whitespace to single
    Dim i, strTemp, strOut, strCh

    strTemp = Str
    For i = 1 To Len(strTemp)
        strCh = Mid(strTemp, i, 1) '***look at each character in turn
        '***if the chr is a space and the previous added chr was a space ignore it
        '***otherwise add it on
        If Not (strCh = " " And Right(strOut, 1) = " ") Or strCh = "." Then
            strOut = strOut & strCh
        End If
    Next
    TrimAll = strOut
End Function

Do you perhaps, as an expert, have a better way of achieving this? I'm still not sure how to change the -999.25 value to a 0 value when writing file. This is some of the code I have that I am working with, but it's not fully functional right now. Can you help me? Thanks for your time

[vb5prgrmr]

Okay, a couple of things about your code...

The Depth, fph, mpf, pdc variables are all varients. The only one actually declared as a string is slide.

Using the FSO increases the use of memory resources and is slower than using the native open statement.

In my previous example to you, there was a reason I used the freefile function as hard coding file numbers can lead to instability if not completly crashing your program.

Also, you declare the Slide variable, put a value in it, but never write it out...

Dim FName As String, FNumb As Integer
Dim InnerForLoopCounter As Integer, OuterForLoopCounter As Integer
Dim LineArray() As String, ElementArray() As String
Dim InputText As String, OutputText As String

Dim Depth As String, fph As String, mpf As String
Dim pdc As String, Slide As String
  
FName = "InputPathFileName" 'need to change
FNumb = FreeFile
  
Open FName For Input As #FNumb
InputText = Input(FileLen(FName), #FNumb)
Close #FNumb
  
LineArray = Split(InputText, vbNewLine)
  
'Skip First 64
For OuterForLoopCounter = 63 To UBound(LineArray)
  
  ElementArray = Split(LineArray(OuterForLoopCounter), vbTab)
  
  Depth = Trim(ElementArray(0))
  
  If Trim(ElementArray(1)) = "-999.25" Then
    fph = "0"
  Else
    fph = Trim(ElementArray(1))
  End If

  If Trim(ElementArray(2)) = "-999.25" Then
    mpf = "0"
  Else
    mpf = Trim(ElementArray(2))
  End If
  
  If Trim(ElementArray(3)) = "-999.25" Then
    pdc = "0"
  Else
    pdc = Trim(ElementArray(3))
  End If
  
  If Trim(ElementArray(4)) = "-999.25" Then
    Slide = "0"
  Else
    Slide = Trim(ElementArray(4))
  End If
  
  OutputText = OutputText & mpf & vbTab & pdc & vbTab & Depth & vbTab & fph & vbNewLine
  'however you are missing the slide variable...
  
Next OuterForLoopCounter
  
FName = "OutputPathFileName" 'need to change
FNumb = FreeFile
  
Open FName For Output As #FNumb
Print #FNumb, OutputText
Close #FNumb

Good Luck

[kimmelsd33]

Thanks for your reply. I changed the code to what you had provided, and now I am running into some errors. One error is "Run-time error '9': Subscript out of range". The other is that it's not replacing the "-999.25" with the "0". This is what I have:

Dim FName As String, FNumb As Integer
Dim InnerForLoopCounter As Integer, OuterForLoopCounter As Integer
Dim LineArray() As String, ElementArray() As String
Dim InputText As String, OutputText As String
 
Dim depth As String, fph As String, mpf As String, pdc As String, slide As String
Dim shale As String, silt As String, sand As String, chalk As String, lime As String
Dim dolo As String, anhy As String, gyp As String, salt As String, coal As String
Dim chert As String, cement As String, nosamp As String, tgas As String, c1 As String
Dim c2 As String, c3 As String, c4i As String, c4n As String, mwin As String, mwout As String
Dim mtmpin As String, mtmpout As String

FName = "C:\DB_CUE\5inchto1inch.las" 'need to change
FNumb = FreeFile
 
Open FName For Input As #FNumb
InputText = Input(FileLen(FName), #FNumb)
Close #FNumb
 
LineArray = Split(InputText, vbNewLine)
 
'Skip First 64
For OuterForLoopCounter = 64 To UBound(LineArray)
 
    ElementArray = Split(LineArray(OuterForLoopCounter), "               ") 'vbTab
 
    depth = Trim(ElementArray(0))
 
  If Trim(ElementArray(1)) = "-999.25" Then
    fph = "0"
  Else
    fph = Trim(ElementArray(1))
  End If
  If Trim(ElementArray(2)) = "-999.25" Then
    mpf = "0"
  Else
    mpf = Trim(ElementArray(2))
  End If
  If Trim(ElementArray(3)) = "-999.25" Then
    pdc = "0"
  Else
    pdc = Trim(ElementArray(3))
  End If
  If Trim(ElementArray(4)) = "-999.25" Then
    slide = "0"
  Else
    slide = Trim(ElementArray(4))
  End If
  If Trim(ElementArray(5)) = "-999.25" Then
    shale = "0"
  Else
    shale = Trim(ElementArray(5))
  End If
  If Trim(ElementArray(6)) = "-999.25" Then
    silt = "0"
  Else
    silt = Trim(ElementArray(6))
  End If
  If Trim(ElementArray(7)) = "-999.25" Then
    sand = "0"
  Else
    sand = Trim(ElementArray(7))
  End If
  If Trim(ElementArray(8)) = "-999.25" Then
    chalk = "0"
  Else
    chalk = Trim(ElementArray(8))
  End If
  If Trim(ElementArray(9)) = "-999.25" Then
    lime = "0"
  Else
    lime = Trim(ElementArray(9))
  End If
  If Trim(ElementArray(10)) = "-999.25" Then
    dolo = "0"
  Else
    dolo = Trim(ElementArray(10))
  End If
  If Trim(ElementArray(11)) = "-999.25" Then
    anhy = "0"
  Else
    anhy = Trim(ElementArray(11))
  End If
  If Trim(ElementArray(12)) = "-999.25" Then
    gyp = "0"
  Else
    gyp = Trim(ElementArray(12))
  End If
  If Trim(ElementArray(13)) = "-999.25" Then
    salt = "0"
  Else
    salt = Trim(ElementArray(13))
  End If
  If Trim(ElementArray(14)) = "-999.25" Then
    coal = "0"
  Else
    coal = Trim(ElementArray(14))
  End If
  If Trim(ElementArray(15)) = "-999.25" Then
    chert = "0"
  Else
    chert = Trim(ElementArray(15))
  End If
  If Trim(ElementArray(16)) = "-999.25" Then
    cement = "0"
  Else
    cement = Trim(ElementArray(16))
  End If
  If Trim(ElementArray(17)) = "-999.25" Then
    nosamp = "0"
  Else
    nosamp = Trim(ElementArray(17))
  End If
  If Trim(ElementArray(18)) = "-999.25" Then
    tgas = "0"
  Else
    tgas = Trim(ElementArray(18))
  End If
  If Trim(ElementArray(19)) = "-999.25" Then
    c1 = "0"
  Else
    c1 = Trim(ElementArray(19))
  End If
  If Trim(ElementArray(20)) = "-999.25" Then
    c2 = "0"
  Else
    c2 = Trim(ElementArray(20))
  End If
  If Trim(ElementArray(21)) = "-999.25" Then
    c3 = "0"
  Else
    c3 = Trim(ElementArray(21))
  End If
  If Trim(ElementArray(22)) = "-999.25" Then
    c4i = "0"
  Else
    c4i = Trim(ElementArray(22))
  End If
  If Trim(ElementArray(23)) = "-999.25" Then
    c4n = "0"
  Else
    c4n = Trim(ElementArray(23))
  End If
  If Trim(ElementArray(24)) = "-999.25" Then
    mwin = "0"
  Else
    mwin = Trim(ElementArray(24))
  End If
  If Trim(ElementArray(25)) = "-999.25" Then
    mwout = "0"
  Else
    mwout = Trim(ElementArray(25))
  End If
  If Trim(ElementArray(26)) = "-999.25" Then
    mtmpin = "0"
  Else
    mtmpin = Trim(ElementArray(26))
  End If
  If Trim(ElementArray(27)) = "-999.25" Then
    mtmpout = "0"
  Else
    mtmpout = Trim(ElementArray(27))
  End If
  
  OutputText = OutputText & depth & vbTab & fph & vbTab & mpf & vbTab & slide & vbTab & pdc & vbTab & tgas & vbTab & c1 & vbTab _
    & c2 & vbTab & c3 & vbTab & c4i & vbTab & c4n & vbTab & shale & vbTab & silt & vbTab & sand & vbTab & chalk & vbTab & dolo & vbTab _
    & ahhy & vbTab & gyp & vbTab & salt & coal & vbTab & chert & vbTab & cement & vbTab & nosamp & vbTab & mwin & vbTab & mwout & vbTab _
    & mtmpin & vbTab & mtmpout & vbNewLine
    
 Debug.Print OutputText
 
Next OuterForLoopCounter
 
FName = "C:\Temp.dat" 'need to change
FNumb = FreeFile
 
Open FName For Output As #FNumb
Print #FNumb, OutputText
Close #FNumb

The file isn't using the standard tab key to space between the values. That's why I am using the amount of space that I am. It is working, but gives an error when it gets to a depth of 8000. Not sure. I can send the attachment if you would like. Thanks for any and all help.

[kimmelsd33]

Help With Tab Delimited File-Reading &amp; Rearranging Values

Thanks for all the help vb5prgrmr. I figured out what I was doing wrong with the code. I can't thank you enough for your help. I am looking forward to possibly helping others just as you have helped me. Thanks again for your time and work.

[vb5prgrmr]

Your very welcome...

However, one way in which to shorten up your code is to use an array instead of all those variables and that would allow you to loop through the values. So maybe a change here to use an inner loop for 1 to 25 and to even make it easier, reuse the array already created...

For InnerForLoopCounter = 1 To 25
  If Trim(ElementArray(InnerForLoopCounter)) = "-999.25" Then
    ElementArray(InnerForLoopCounter) = "0"
  Else
    ElementArray(InnerForLoopCounter) = Trim(ElementArray(InnerForLoopCounter))
  End If
Next InnerForLoopCounter

Then you could simply do this if you wanted...

Variable1 = ElementArray(1)
Variable2 = ElementArray(2)
'...
Variable25 = ElementArray(25)

This would be the same functionality as you have just a bit less code.

Either way I'm glad you got it solved.



Good Luck

[kimmelsd33]

Thanks for all the help. How could I implement a progress bar to advance the value as it reads the lines of data in the file its processing? I have looked at some examples online, but none really say how to link the progressbar.max to the file size or line size of the file. Thanks again

[vb5prgrmr]

'before the outer loop
PB.Max = UBound(LineArray) + 1 'just in case
'then somewhere in the loop
PB.Value = OuterForLoopCounter
PB.Refresh 'allow the progress bar to update itself

Good Luck

[kimmelsd33]

Thanks for the help. After all the work, I have encountered a serious problem. The file I am reading from, is not in a standard tab delimited format. Is there anyway to modify the code as it reads line by line, and say that if its a leading space and a trailing space, then move on; If its a number then save it to a variable? Then write the variables to a standard tab delimited format. Does this make sense? I can send the file I am working with, if you like? The code is as follows:

Dim FName As String, FNumb As Integer
    Dim InnerForLoopCounter As Integer, OuterForLoopCounter As Integer
    Dim LineArray() As String, ElementArray() As String
    Dim InputText As String, OutputText As String
    Dim a As Integer
    Dim depth As String, fph As String, mpf As String, pdc As String, slide As String
    Dim shale As String, silt As String, sand As String, chalk As String, lime As String
    Dim dolo As String, anhy As String, gyp As String, salt As String, coal As String
    Dim chert As String, cement As String, nosamp As String, tgas As String, c1 As String
    Dim c2 As String, c3 As String, c4i As String, c4n As String, mwin As String, mwout As String
    Dim mtmpin As String, mtmpout As String
FName = tFile 'need to change
        FNumb = FreeFile
        
        a = LinesInFile(tFile) 'count number of lines for progress bar
        
        Open FName For Input As #FNumb
            InputText = Input(FileLen(FName), #FNumb)
        Close #FNumb

        LineArray = Split(InputText, vbNewLine)
        'Skip First 64
        For OuterForLoopCounter = 64 To UBound(LineArray)
            ElementArray = Split(LineArray(OuterForLoopCounter), "      ") 'vbTab
For InnerForLoopCounter = 1 To 28
                    If Trim(ElementArray(InnerForLoopCounter)) = "-999.25" Then
                        ElementArray(InnerForLoopCounter) = "0"
                    Else
                        ElementArray(InnerForLoopCounter) = Trim(ElementArray(InnerForLoopCounter))
                    End If

                    depth = Format(ElementArray(1), "0")
                    fph = Format(ElementArray(2), "0.0")
                    mpf = Format(ElementArray(3), "0.00")
                    pdc = ElementArray(4)
                    slide = ElementArray(5)
                    shale = ElementArray(6)
                    silt = ElementArray(7)
                    sand = ElementArray(8)
                    chalk = ElementArray(9)
                    lime = ElementArray(10)
                    dolo = ElementArray(11)
                    anhy = ElementArray(12)
                    gyp = ElementArray(13)
                    salt = ElementArray(14)
                    coal = ElementArray(15)
                    chert = ElementArray(16)
                    cement = ElementArray(17)
                    nosamp = ElementArray(18)
                    tgas = ElementArray(19)
                    c1 = ElementArray(20)
                    c2 = ElementArray(21)
                    c3 = ElementArray(22)
                    c4i = ElementArray(23)
                    c4n = ElementArray(24)
                    mwin = Format(ElementArray(25), "0.0")
                    mwout = Format(ElementArray(26), "0.0")
                    mtmpin = ElementArray(27)
                    mtmpout = ElementArray(28)

                Next InnerForLoopCounter
OutputText = OutputText & depth & vbTab & fph & vbTab & mpf & vbTab & slide _
            & vbTab & pdc & vbTab & tgas & vbTab & c1 & vbTab & c2 & vbTab & c3 _
            & vbTab & c4i & vbTab & c4n & vbTab & shale & vbTab & silt & vbTab & sand _
            & vbTab & chalk & vbTab & lime & vbTab & dolo & vbTab & ahhy & vbTab & gyp _
            & vbTab & salt & vbTab & coal & vbTab & chert & vbTab & cement & vbTab & nosamp _
            & vbTab & mwin & vbTab & mwout & vbTab & mtmpin & vbTab & mtmpout & vbNewLine
Next OuterForLoopCounter
Open FName For Output As #FNumb
        Print #FNumb, OutputText
        Close #FNumb

Hope this is all making sense.