Text Import of Multiline(2) data to one row in Excel

[Llort]

I am currently making this text import friendly by find/replace "[Space][CR]<SPACE><CR>" with "[Space]<SPACE> in word to make it all one line. Would like to eliminate that step. Never done any VBA, but willing to take on the challenge. Have been told my data source cannot be reformatted to remove return.



Time Pt Type Tag Type [CR]<CR>
13:33:43 STATUS CO - Special Condition [CR] <CR>
phase prior to closing[CR]<CR>
13:33:43 STATUS CO - Special Condition [CR] <CR>
phase prior to closing[CR]<CR>
13:48:27 STATUS CO - Special Condition [CR]
[blank][CR]
20:33:31 STATUS SI - Scan Inhibit [CR]
[blank][CR]
08:33:44 STATUS AI - Alarm Inhibit [CR]<CR>
Waiting for UG to cut-in sfb 3/09/11[CR]
<CR>

Thanks

Using Excel 2007, could use Access if it would make import easier.

 

[Ruddles]

I can suggest a number of ways of doing this:-

1. Write some VBA to 'pre-process' the text file before you import it. Leave the first line unchanged and join each subsequent pair of lines, provided the first line of the pair starts with a valid time and the second line doesn't (to prevent you modifying the same file more than once).
2. Write some VBA to import the text file. Import the first line as it is and import the rest of the file tow lies at a time, joining the pair of lines and placing them on the same worksheet row.
3. Import the file as it stands into a worksheet, then write some VBA to join row 2 and 3 together, 4 and 5 together, etc.

Personally I think #2 is the best option as it combines the importing and reformatting into a single step.

You say you're "willing to take on the challenge". I don't want to spoil the challenge by handing you the solution on a plate, nor do I want to leave you floundering for lack of information. So, do you want an entire solution posted here or merely some hints & tips?

 

[Llort]

I would love a cut and paste solution #2, it is liable to be enough of a challenge to figure out where to put such a solution and make the built in security cooperate.
Maybe up for challenge was too strong of wording. Rather should of read I am challenged.

 

[Ruddles]

Okay, if I've understood the way your input file is formatted, this code should do the trick:-

[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub ImportLogFile()[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Dim ws As Worksheet
  Dim iPtr As Integer
  Dim sFileName As String
  Dim iRow As Long
  Dim intFH As Integer
  Dim iRec As Long
  Dim sRec As String
  Dim sTime As Date
  
  sFileName = Application.GetOpenFilename( _
              FileFilter:="Text files (*.txt), *.txt, Log files (*.log), *.log, All files (*.*), *.*")
  If sFileName = "False" Then Exit Sub
  
  sTime = Now()
  Set ws = ThisWorkbook.Sheets(1)
  ws.UsedRange.ClearContents
  
  Close
  intFH = FreeFile()
  Open sFileName For Input As intFH
  
  Cells.ClearContents
  Range("A1").Select
  sTime = Now()
    
  Line Input #intFH, sRec
  iRec = 1
  ws.Range("A1:D1") = Array("Time", "Pt", "Type", "Tag Type")
  ws.Range("A1:D1").Font.Bold = True
  iRow = 1
  
  Do Until EOF(intFH)
    iRow = iRow + 1
    Line Input #intFH, sRec
    iRec = iRec + 1
    ws.Cells(iRow, "A") = Left(sRec, 8)
    sRec = Mid(sRec, 10)
    iPtr = InStr(sRec, "-")
    ws.Cells(iRow, "B") = Trim(Left(sRec, iPtr - 1))
    sRec = Trim(Mid(sRec, iPtr + 1))
    ws.Cells(iRow, "C") = Trim(sRec)
    Line Input #intFH, sRec
    iRec = iRec + 1
    ws.Cells(iRow, "D") = Trim(sRec)
  Loop
  
  Close intFH
  
  ws.Columns("A:D").EntireColumn.AutoFit
   
  MsgBox "Finished:-" & Space(10) & vbCrLf & vbCrLf _
       & CStr(iRec) & " lines read from " & sFileName & Space(10) & vbCrLf & vbCrLf _
       & CStr(iRow - 1) & " records imported to worksheet" & vbCrLf & vbCrLf _
       & "Run time: " & Format(Now() - sTime, "hh:nn:ss"), _
       vbOKOnly + vbInformation[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]End Sub[/FONT]

Do you know how to run this code or would you like instructions?

 

[Ruddles]

If it doesn't work, I'll need you to paste the top twenty or so lines of a typical log file directly into a forum message, without indicating where the CR characters are, so I can recreate the file on my own system.

 

[Llort]

My actual data contains more columns than the example I provided above, took a while to reverse engineer and apply to my problem. I liked the way you removed the dash and made seperate cells for the Tag Type, I will work further on implementing the seperation. I ran into an issue as the abbreviated name is sometimes 4 characters.

INFO - Information
SI - Scan Inhibit

Option Explicit
 
Public Sub ImportLogFile()
 
  Dim ws As Worksheet
  Dim iPtr As Integer
  Dim sFileName As String
  Dim iRow As Long
  Dim intFH As Integer
  Dim iRec As Long
  Dim sRec As String
  Dim sTime As Date
 
  sFileName = Application.GetOpenFilename( _
              FileFilter:="Text files (*.txt), *.txt, Log files (*.log), *.log, All files (*.*), *.*")
  If sFileName = "False" Then Exit Sub
 
  sTime = Now()
  Set ws = ThisWorkbook.Sheets(1)
  ws.UsedRange.ClearContents
 
  Close
  intFH = FreeFile()
  Open sFileName For Input As intFH
 
  Cells.ClearContents
  Range("A1").Select
  sTime = Now()
 
  Line Input #intFH, sRec
  iRec = 1
  ws.Range("A1:L1") = Array("Time", "Pt Type", "Tp", "Tag Type", "St Desc", "Pt Desc", "Station", "Category", "Point", "TID", "Operation", "Reason")
  ws.Range("A1:L1").Font.Bold = True
  iRow = 1
 
  Do Until EOF(intFH)
    iRow = iRow + 1
    Line Input #intFH, sRec
    iRec = iRec + 1
    ws.Cells(iRow, "A") = Left(sRec, 20)
    ws.Cells(iRow, "B") = Mid(sRec, 21, 11)
    'iPtr = InStr(sRec, "-")
    'ws.Cells(iRow, "C") = Trim(Left(sRec, iPtr - 1))
    'sRec = Trim(Mid(sRec, iPtr + 1))
    'ws.Cells(iRow, "D") = Trim(sRec)
    ws.Cells(iRow, "C") = Mid(sRec, 33, 2)
    ws.Cells(iRow, "D") = Mid(sRec, 38, 26)
    ws.Cells(iRow, "E") = Mid(sRec, 65, 17)
    ws.Cells(iRow, "F") = Mid(sRec, 94, 47)
    ws.Cells(iRow, "G") = Mid(sRec, 142, 8)
    ws.Cells(iRow, "H") = Mid(sRec, 151, 9)
    ws.Cells(iRow, "I") = Mid(sRec, 161, 9)
    ws.Cells(iRow, "J") = Mid(sRec, 171, 43)
    ws.Cells(iRow, "K") = Mid(sRec, 215, 31)
    Line Input #intFH, sRec
    iRec = iRec + 1
    ws.Cells(iRow, "L") = Trim(sRec)
  Loop
 
  Close intFH
 
  ws.Columns("A:L").EntireColumn.AutoFit
 
  MsgBox "Finished:-" & Space(10) & vbCrLf & vbCrLf _
       & CStr(iRec) & " lines read from " & sFileName & Space(10) & vbCrLf & vbCrLf _
       & CStr(iRow - 1) & " records imported to worksheet" & vbCrLf & vbCrLf _
       & "Run time: " & Format(Now() - sTime, "hh:nn:ss"), _
       vbOKOnly + vbInformation
 
End Sub

Thought you deserved an update, thanks for the jump start.

 

[Ruddles]

Thanks for the feedback. You know where to come if you hit any more obstacles!