Extracting specific data from text file to excel spreadsheet

[Chenn]

Hello all!
I am working on a macro that will pull specific data from a text file and put it into a spreadsheet. It has to be user friendly because after it is completed, I will not be the one who is using it.

I have looked on many sites and came up with this code to make it pick out the first data but I am having trouble having it move on from the initial set. I am trying to pull the room number and the transaction completed time through to an excel spreadsheet.

<strike></strike>Sub Button1_Click()


Dim MyFile As String, text As String, textline As String, Room As Integer, Time As String


MyFile = Application.GetOpenFilename()



Open MyFile For Input As #1


row_number = 0


Do Until EOF(1)

Line Input #1, textline
text = text & textline



Room = InStr(text, "ROOM")
Time = InStr(text, "Completed")


ActiveCell.Offset(row_number, 0) = Mid(text, Room + 5, 5)
ActiveCell.Offset(row_number, 1) = Mid(text, Time + 10, 5)



row_number = row_number + 1


Loop


Close #1



End Sub


The information that I am pulling looks like this in the text file.

ROOM 4268.2 07:07:12 11/18/15
Normal 00:00
***Transaction Completed 00:23
ROOM 4262 07:04:59 11/18/15
Normal 00:00
Cancelled 01:29
Normal OT 01:33
***Transaction Completed 03:35
ROOM 4280.2 07:25:09 11/18/15
Normal 00:00
***Transaction Completed 01:00
ROOM 4271.2 07:32:50 11/18/15
Normal 00:00
Cancelled 01:33
Normal OT 01:37
***Transaction Completed 02:26
ROOM 4262 07:35:22 11/18/15
Normal 00:00
Cancelled 01:27
Normal OT 01:31
***Transaction Completed 01:57


Any and all help would be greatly appreciated!

 

[Rick Rothstein]

See if this code does what you want...

[table="width: 500"]
[tr]
	[td]Sub Button1_Click()
  Dim X As Long, FileNum As Long, TotalFile As String, Rooms() As String
  FileNum = FreeFile
  Open Application.GetOpenFilename() For Binary As #FileNum
    If LOF(FileNum) = 0 Then Exit Sub
    TotalFile = Space(LOF(FileNum))
    Get #FileNum, , TotalFile
  Close #FileNum
  Rooms = Split(TotalFile, "ROOM ")
  For X = 1 To UBound(Rooms)
    Cells(X + 1, "A").Value = Left(Rooms(X), InStr(Rooms(X), " ") - 1)
    Cells(X + 1, "B").Value = Mid(Rooms(X), Len(Rooms(X)) - 4 - Len(vbNewLine), 4)
  Next
End Sub[/td]
[/tr]
[/table]

Note: I placed the output in Columns A and B starting at Row 2 (which assumes you have headers in Row 1). You can change the output location in the two Cells calls inside the For..Next loop if desired.

 

[Chenn]

Rick,

Thank you for all of your help! It worked perfectly!

 

[Chenn]

Rick,

The code worked perfectly but now I was requested to add the time and date as separate columns... I've been working with the code you supplied me and I came up with this to bring the time but I am having trouble with 1. removing the space in front of the time and 2. making the date come with the information.

Private Sub CommandButton1_Click()
Dim X As Long, FileNum As Long, TotalFile As String, Rooms() As String
FileNum = FreeFile
Open Application.GetOpenFilename() For Binary As #FileNum
If LOF(FileNum) = 0 Then Exit Sub
TotalFile = Space(LOF(FileNum))
Get #FileNum, , TotalFile
Close #FileNum
Rooms = Split(TotalFile, "ROOM ")
For X = 1 To UBound(Rooms)
Cells(X + 1, "A").Value = Left(Rooms(X), InStr(Rooms(X), " ") - 1)
Cells(X + 1, "B").Value = Mid(Rooms(X), Len(Rooms(X)) - 12 - Len(vbNewLine), 5)
Cells(X + 1, "C").Value = Mid(Rooms(X), InStr(Rooms(X), " "), 9)
Next
End Sub

Once again, all of your help is greatly appreciated!

 

[Rick Rothstein]

Does this do what you want...

[table="width: 500"]
[tr]
	[td]Sub Button1_Click()
  Dim X As Long, FileNum As Long, TotalFile As String, Rooms() As String[B][COLOR="#0000FF"], Words() As String[/COLOR][/B]
  FileNum = FreeFile
  Open Application.GetOpenFilename() For Binary As #FileNum
    If LOF(FileNum) = 0 Then Exit Sub
    TotalFile = Space(LOF(FileNum))
    Get #FileNum, , TotalFile
  Close #FileNum
  Rooms = Split(TotalFile, "ROOM ")
  For X = 1 To UBound(Rooms)
    Cells(X + 1, "A").Value = Left(Rooms(X), InStr(Rooms(X), " ") - 1)
    Cells(X + 1, "B").Value = Mid(Rooms(X), Len(Rooms(X)) - 4 - Len(vbNewLine), 4)
[B][COLOR="#0000FF"]    Words = Split(Split(Rooms(X), vbNewLine)(0))
    Cells(X + 1, "C").Value = Words(UBound(Words))[/COLOR][/B]
  Next
End Sub[/td]
[/tr]
[/table]