Multiple Loop for Reading a text file with tags

newbie001

New Member
Joined
Mar 25, 2014
Messages
9
Hi Sirs,

I have a problem regarding sorting our books on our store. The database extracted in textfile is somehat like this
<bookstart
<bookstart
<bookstart
**BOOKSTART
SERIAL=3234123532;
AUTHORSN=12343234;
CASE=11;
CLASS=1-1-101-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=2-9-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=3-4-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=4-7-101-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=5-3-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
<bookend
**BOOKEND
<bookstart< em="">**BOOKSTART
<bookend
<bookend
<bookstart
SERIAL=3234123533;
AUTHORSN=12343234;
CASE=11;
CLASS=1-1-101-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=2-9-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=5-4-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=4-7-101-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=8-3-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
<bookend< em="">**BOOKEND
<bookend
</bookend
</bookend<>
</bookstart
</bookend
</bookend
</bookstart<>
</bookend
</bookstart
</bookstart
</bookstart
I want to tabulate all the book on excel but i don't know how to do it via VBA. I just want to get the first two columns on the CLASS tag. The First Column of the CLASS tag is the BOOK LOCATION, and the Second Column is the Storage Location


I want to match the BOOKLOCATION Number to the Storage Location like the one on the table below. I have thousand of records. i want to sort. I hope you can help me on my dilemma. =(
SERIAL
AUTHOR
CASE
1
2
3
4
5
6
7
8
9
3234123532
12343234
11
1
5
3
4
2
3234123533
12343234
11
1
8
5
4
2

<tbody>
</tbody>
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,504
Office Version
2010
Platform
Windows
<bookstart
<bookstart
<bookstart

SERIAL=3234123532;
AUTHORSN=12343234;
CASE=11;
CLASS=1-1-101-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=2-9-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=3-4-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=4-7-101-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=5-3-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
<bookend
**BOOKEND
<bookstart< em="">**BOOKSTART
<bookend
<bookend
<bookstart
SERIAL=3234123533;
AUTHORSN=12343234;
CASE=11;
CLASS=1-1-101-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=2-9-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=5-4-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=4-7-101-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=8-3-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
<bookend< em="">**BOOKEND
</bookend<>
</bookstart
</bookend
</bookend
</bookstart<>
</bookend
</bookstart
</bookstart
</bookstart
Assuming your text file looks like what you posted above, the following macro will read in the data directly from the text file, add a new sheet named Books followed by the date/time formatted as ddmmyyyyhhmmss, and then populate this sheet with the data from the file distributed as you showed in your original message. You need to do two things to the macro... one, change my example path and filename (highlighted in red) to the actual path and filename to your text file and, two, change my example value of 9 (shown in blue)(taken from your sample output table) in the MaxLocations constant (the Const statement) to the maximum number of locations that could ever be found in the file.
Rich (BB code):
Sub Books()
  Dim X As Long, Y As Long, Z As Long, FileNum As Long, RowOut As Long
  Dim PathFilename As String, TotalFile As String
  Dim CaseNum As String, Serial As String, Author As String, Location As String
  Dim Books() As String, Classes() As String, Class() As String, ClassLoc() As String
  Const MaxLocations As Long = 9
  PathFilename = "C:\temp\TestFile.txt"
  FileNum = FreeFile
  Open PathFilename For Binary As #FileNum
    TotalFile = Space(LOF(FileNum))
    Get #FileNum, , TotalFile
  Close #FileNum
  Books = Split(TotalFile, "**BOOKSTART" & vbNewLine)
  With Sheets.Add
    .Name = "Books " & Format(Now, "mmddyyyyhhmmss")
    Range("A1:C3") = Array("SERIAL", "AUTHOR", "CASE")
    For X = 1 To MaxLocations
      Cells(1, X + 3) = X
    Next
    For X = 1 To UBound(Books)
      ReDim Class(1 To MaxLocations)
      Serial = Split(Split(Books(X), "SERIAL=", 2)(1), ";")(0)
      Author = Split(Split(Books(X), "AUTHORSN=", 2)(1), ";")(0)
      CaseNum = Split(Split(Books(X), "CASE=", 2)(1), ";")(0)
      Cells(X + 1, "A").Resize(, 3) = Array(Serial, Author, CaseNum)
      Classes = Split(Books(X), "CLASS=")
      For Y = 1 To UBound(Classes)
        ClassLoc = Split(Classes(Y), "-", 3)
        Class(ClassLoc(1)) = ClassLoc(0)
      Next
      Cells(X + 1, "D").Resize(, MaxLocations) = Class
    Next
  End With
  Columns(1).Resize(3 + MaxLocations).AutoFit
End Sub
 

newbie001

New Member
Joined
Mar 25, 2014
Messages
9
Hello Sir Rick,
First of all thank you for helping me in my problem. But its seem the Script fails ifthe AUTHOR'S FIELD or the CASE Field is blank.
How to tell it to continue and just leave the blank data empty.
 
Last edited:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,504
Office Version
2010
Platform
Windows
Hello Sir Rick,
First of all thank you for helping me in my problem. But its seem the Script fails ifthe AUTHOR'S FIELD or the CASE Field is blank.
If you do not tell us that would be a possibility, then we do not know to design for it. So, what exactly do you mean by "blank"? Using CASE as an example, does "blank" mean this is in the file...

-----snip-----
AUTHORSN=12343234;
CASE=;
CLASS=1-1-101-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;

-----snip-----

or does blank mean the "CASE=" line is not in the file at all at that location?
 

newbie001

New Member
Joined
Mar 25, 2014
Messages
9
Sorry if i confuse you. Because there is a entry on our database like the one below. There is no AUTHORSN= field after the SERIAL=. Because Author Field is not mandatory.

**BOOKSTART
SERIAL=3234126553;
CASE=11;
CLASS=4-7-101-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=5-3-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=100-9-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
**BOOKEND
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,504
Office Version
2010
Platform
Windows
Sorry if i confuse you. Because there is a entry on our database like the one below. There is no AUTHORSN= field after the SERIAL=. Because Author Field is not mandatory.

**BOOKSTART
SERIAL=3234126553;
CASE=11;
CLASS=4-7-101-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=5-3-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
CLASS=100-9-1-241-33-NONE-0-NONE-00000000-65535-0-0-DP_UPS-NONE;
**BOOKEND
Okay, then give this macro a try...

Code:
Sub Books()
  Dim X As Long, Y As Long, Z As Long, FileNum As Long, RowOut As Long
  Dim PathFilename As String, TotalFile As String, Class As Variant
  Dim CaseNum As String, Serial As String, Author As String, Location As String
  Dim Books() As String, Classes() As String, ClassLoc() As String
  Const MaxLocations As Long = 9
  PathFilename = "C:\temp\TestFile.txt"
  FileNum = FreeFile
  Open PathFilename For Binary As #FileNum
    TotalFile = Space(LOF(FileNum))
    Get #FileNum, , TotalFile
  Close #FileNum
  Books = Split(TotalFile, "**BOOKSTART" & vbNewLine)
  With Sheets.Add
    .Name = "Books " & Format(Now, "mmddyyyyhhmmss")
    Range("A1:C3") = Array("SERIAL", "AUTHOR", "CASE")
    For X = 1 To MaxLocations
      Cells(1, X + 3) = X
    Next
    For X = 1 To UBound(Books)
      ReDim Class(1 To MaxLocations)
      Serial = Split(Split(Books(X) & "SERIAL=", "SERIAL=", 2)(1), ";")(0)
      Author = Split(Split(Books(X) & "AUTHORSN=;", "AUTHORSN=", 2)(1), ";")(0)
      CaseNum = Split(Split(Books(X) & "CASE=;", "CASE=", 2)(1), ";")(0)
      Cells(X + 1, "A").Resize(, 3) = Array(Serial, Author, CaseNum)
      Classes = Split(Books(X), "CLASS=")
      For Y = 1 To UBound(Classes)
        ClassLoc = Split(Classes(Y), "-", 3)
        Class(ClassLoc(1)) = ClassLoc(0)
      Next
      Cells(X + 1, "D").Resize(, MaxLocations) = Class
    Next
  End With
  Columns(1).Resize(3 + MaxLocations).AutoFit
End Sub
 

newbie001

New Member
Joined
Mar 25, 2014
Messages
9
Sir Rick,
Thank you very much... you really save me a huge time. If i can, I will buy you a coffee for helping me. Thanks.
 

newbie001

New Member
Joined
Mar 25, 2014
Messages
9
Sir Rick, Good Day, i run a huge database today and after 28,786 it has a error Subscript our of range. Run-Time Error 9
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,504
Office Version
2010
Platform
Windows
Sir Rick, Good Day, i run a huge database today and after 28,786 it has a error Subscript our of range. Run-Time Error 9
What line of code was highlighted when that error occurred?
 

Forum statistics

Threads
1,081,617
Messages
5,360,044
Members
400,565
Latest member
Tommy O

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top