VBA retrieve data from text file

[sh1pley]

Hi I have a text file with 1000's of lines of data (bank statement details). I have called the text file "Upload" and can save it on any drive

The blocks of data I am interested in are seperated by a hyphon "-"

I need to scan through the data block and where the description starts :20: but the trailing number in column A, where the description starts :25: but the trailing number in B. Where the description starts :28: I need to put the first part in column C and the 2nd part in column D (they are seperated by a "/"). Then move onto the next block of data (after the hyphon) and repeat

An example of the file is:

:20:9400124556152110
:25:10455644
:28:37/1
Other stuff
Other stuff
Other stuff
-
:20:9400124556153167
:25:10455689
:28:37/2
Other stuff
Other stuff
Other stuff
-

Any help would be greatly appreciated!

 

[Ruddles]

Something along the following lines might do the trick. Create a blank worksheet, paste this code into the worksheet code module and run it.

[FONT=Courier New][SIZE=1]Option Explicit[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]Public Sub ReadFiles()[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]  Dim sFile As String
  Dim intFH As Integer
  Dim sRec As String
  Dim iRow As Long
  Dim iPtr As Integer
  
  iPtr = InStrRev(ActiveWorkbook.FullName, ".")
  sFile = Left(ActiveWorkbook.FullName, iPtr - 1) & ".txt"
  sFile = Application.GetOpenFilename(FileFilter:="text files (*.txt), *.txt")
  If sFile = "False" Then Exit Sub
  
  Columns("A:D").ClearContents
  Close
  intFH = FreeFile()
  iRow = 0
  Open sFile For Input As #intFH
  Do Until EOF(intFH)
    Line Input #intFH, sRec
    Select Case Left(sRec, 4)
      Case ":20:"
        iRow = iRow + 1
        Cells(iRow, 1) = "'" & Mid(sRec, 5)
      Case ":25:"
        Cells(iRow, 2) = "'" & Mid(sRec, 5)
      Case ":28:"
        sRec = Mid(sRec, 5)
        iPtr = InStr(sRec, "/")
        Cells(iRow, 3) = "'" & Left(sRec, iPtr - 1)
        Cells(iRow, 4) = "'" & Mid(sRec, iPtr + 1)
    End Select
  Loop
  Close[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]End Sub[/SIZE][/FONT]

 

[sh1pley]

Cheers for your response

I had to change the code you provided a little as the source data wasnt always clean enough to give the first 4 characters of the line feed

I have another problem with it though!

I was trying to roll the code out for the other elements and if you check the example below I need more data for :86: than is in the line. I also need all the lines below it until there is another :xx: or :xxx:

I assume I need to pass this part through as some sort of array? I have no idea how to achieve this?

:20:9400124556152110
:25:10455644
:28:37/1
:86:Random text Random text Random text
Need this random text too! Need this random text too!
:56F:
Other stuff
Other stuff
Other stuff
-
:20:9400124556153167
:25:10455689
:28:37/2
Other stuff
Other stuff
Other stuff
-

Code im currently using:

Option Explicit

Public Sub ReadFiles()

Dim sFile As String
Dim intFH As Integer
Dim sRec As String
Dim iRow As Long
Dim iPtr As Integer

sFile = Application.GetOpenFilename(FileFilter:="text files (*.txt), *.txt")
If sFile = "False" Then Exit Sub

Cells.ClearContents
Close
intFH = FreeFile()
iRow = 0
Open sFile For Input As #intFH

Do Until EOF(intFH)
Line Input #intFH, sRec

If InStr(sRec, ":20:") = 1 Then
iRow = iRow + 1
Cells(iRow, 1) = "'" & Mid(sRec, 5)

Else

If InStr(sRec, ":25:") = 1 Then

Cells(iRow, 2) = "'" & Mid(sRec, 5)

Else

If InStr(sRec, ":28:") = 1 Then

sRec = Mid(sRec, 5)
iPtr = InStr(sRec, "/")
Cells(iRow, 3) = "'" & Left(sRec, iPtr - 1)
Cells(iRow, 4) = "'" & Mid(sRec, iPtr + 1)

Else

If InStr(sRec, ":86:") = 1 Then

Cells(iRow, 5) = "'" & Mid(sRec, 5)
End If
End If
End If
End If
Loop
Close

End Sub

 

[Ruddles]

Easily coped with - just add this CASE clause to my original code:-

      Case ":86:"
        Cells(iRow, 5) = "'" & Mid(sRec, 5)
        Line Input #intFH, sRec
        Do Until Left(sRec, 1) = ":" Or EOF(intFH)
          Cells(iRow, 5) = Cells(iRow, 5) & " " & sRec
          Line Input #intFH, sRec
        Loop