Transfering non standard data from a text file to an Excel Table

B

Blazing

New Member
Joined
Oct 23, 2009
Messages
25
I have a text file which should transfer to over 5500 rows in an Excel table. I need to transfer it in such a way as to have the data in between the spaces included on one row, with a new cell for each line of data. Here’s a sample of the data:


G0002 <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
Aaron
{ah-ar-ohn'} <o:p></o:p>
of Hebrew origin [175]; <o:p></o:p>
TDNT - 1:3,1; n pr m <o:p></o:p>
AV - Aaron (5) <o:p></o:p>
1) Aaron meaning "a teacher, or lofty". A brother of Moses, the first high priest of Israel

<o:p></o:p>
<o:p></o:p>
G0003 <o:p></o:p>
Abaddon
{ab-ad-dohn'} <o:p></o:p>
vs the alternative spelling ABBADWN <o:p></o:p>
of Hebrew origin [11]; <o:p></o:p>
TDNT - 1:4,1; n pr m <o:p></o:p>
AV - Abaddon (1) <o:p></o:p>
1) Ruin, Destruction <o:p></o:p>
2) The place of destruction <o:p></o:p>
3) Name of the angel-prince of the infernal regions, the <o:p></o:p>
minister of death and the author of havoc on the earth. From <o:p></o:p>
the occurrence of the word in Ps. 88:11, the rabbis have made <o:p></o:p>
Abaddon the nethermost of the two regions into which they <o:p></o:p>
divide the lower world; but that in Rev09:11 Abaddon is the <o:p></o:p>
angel and not the abyss is perfectly evident in the Greek.

<o:p></o:p>
<o:p></o:p>
G0004<o:p></o:p>
abares
{ab-ar-ace'}<o:p></o:p>
from G0001 (as a negative particle) and G0922;<o:p></o:p>
TDNT - omitted,omitted; adj<o:p></o:p>
AV - not burdensome (1)<o:p></o:p>
1) not burdensome, not heavy, light without weight

<o:p></o:p>
<o:p></o:p>
G0005<o:p></o:p>
Abba
{ab-bah'}<o:p></o:p>
of Aramaic origin [2];<o:p></o:p>
TDNT - 1:5,1; n<o:p></o:p>
AV - Abba (3) <o:p></o:p>
1) Father, customary title used of God in prayer
<o:p></o:p>
<o:p></o:p>

G0006 …
<o:p></o:p>
<o:p></o:p>
There are over 5500 of these individual “Records” of varying length and composition. If I could figure out how, I would also like to get similar data in the same columns. The first 3 columns will always match up. After that, only the columns that start “AV”, and “1)” are always included. Other columns appear most of the time, like the ones beginning “TDNT”, or the one that starts “<”. If there is a way to maintain data order and have these columns line up, that would be ideal.

If we can get all of the information for the numbered items into the same cell, even though it is on seperate lines, that would be nice also. Again, even if you can only get me started, that would be great.

If you can even get me “Close” to this output, it would save time. (I had hopes of figuring out how to include a small sample table that lines up with how my finished results need to look, but I can't see how to do that in this box. If you can tell me how to do so, I will add it. Thanks for any help you can offer.
Mike
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Sort by date Sort by votes
I was pretty sure I replied to this post earlier. Anyway here I go again.

Open notepad, copy in the sample data you provided in your post, name the file bible.txt and save it to your c:\drive. If you save it to another location edit this line in the ImportBibleText2 sub.
Code: 
 sFile = "c:\bible.txt"

First the code imports the text file into an array.
Then outputs the array to Sheet1.
Then "Fixes" column D.
Then "Fixes" column G.

The word's soure description appears to cover two lines in record G0003. I have assumed from the other entries that this description ends with a semi-colon. The fix for column D addresses this. This may need amended depending on the rest of the data.

This leaves the numbered comments beginning in column G. The fix for column G edits the output as requested.

To use the code.
Create the bible.txt file using the sample data.
Open a new Excel workbook.
Press Alt+F11 to open the VBA window.
Double click the ThisWorkbook module in the Project Window on the left hand side.
Copy and paste the code below.
Press F5 to run.

Code: 
[COLOR=darkblue]Public[/COLOR] [COLOR=darkblue]Sub[/COLOR] ImportBibleText2()
    [COLOR=darkblue]Dim[/COLOR] sFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]         [COLOR=green]'source file[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] aRecord() [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]    'text array
    [COLOR=darkblue]Dim[/COLOR] sLine [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]         [COLOR=green]'line of text[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] rw [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]              'row index
    [COLOR=darkblue]Dim[/COLOR] Col [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]             [COLOR=green]'column index[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]               'array index
    [COLOR=darkblue]Dim[/COLOR] j [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]               [COLOR=green]'loop index[/COLOR]
 
    sFile = "c:\bible.txt"
 
    [COLOR=darkblue]If[/COLOR] Dir(sFile) = "" [COLOR=darkblue]Then[/COLOR]
        MsgBox "File does not exist"
        [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] CloseOpenFiles
    [COLOR=green]    '=====================================================[/COLOR]
    [COLOR=green]'read the source file one line at a time into an array[/COLOR]
   [COLOR=green]'=====================================================[/COLOR]
    [COLOR=darkblue]Open[/COLOR] (sFile) [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Input[/COLOR] [COLOR=darkblue]As[/COLOR] #1
    i = 0
    [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]While[/COLOR] [COLOR=darkblue]Not[/COLOR] EOF(1)
        [COLOR=darkblue]ReDim[/COLOR] [COLOR=darkblue]Preserve[/COLOR] aRecord(i)
        Line [COLOR=darkblue]Input[/COLOR] #1, sLine
        aRecord(i) = Trim(sLine)
        i = i + 1
    [COLOR=darkblue]Loop[/COLOR]
    [COLOR=darkblue]Close[/COLOR] #1
 
    [COLOR=green]'=================================[/COLOR]
    [COLOR=green]'output the array to the worksheet[/COLOR]
    [COLOR=green]'=================================[/COLOR]
    [COLOR=darkblue]For[/COLOR] j = [COLOR=darkblue]LBound[/COLOR](aRecord) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](aRecord)
        [COLOR=darkblue]If[/COLOR] Left(aRecord(j), 1) = "G" [COLOR=darkblue]Then[/COLOR]
            rw = rw + 1
            Col = 1
        [COLOR=darkblue]Else[/COLOR]
            Col = Col + 1
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        Sheets("Sheet1").Cells(rw, Col).Value = aRecord(j)
    [COLOR=darkblue]Next[/COLOR] j
 
    FixColumnD
    FixColumnG
    Sheets("Sheet1").Columns("A:G").EntireColumn.AutoFit
 
CloseOpenFiles:
    Close #1
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] FixColumnD()
    [COLOR=darkblue]Dim[/COLOR] rng [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] txt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
 
[COLOR=green]  '============[/COLOR]
[COLOR=green]  'fix column D[/COLOR]
[COLOR=green]  '============[/COLOR]
    [COLOR=darkblue]Set[/COLOR] rng = Sheets("Sheet1").Range("D1")
    [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] rng = ""
        [COLOR=darkblue]If[/COLOR] Right(rng, 1) <> ";" [COLOR=darkblue]Then[/COLOR]
            txt = rng & " " & rng.Offset(, 1)
            rng = txt
            rng.Offset(, 1).Delete shift:=xlToLeft
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        txt = ""
        [COLOR=darkblue]Set[/COLOR] rng = rng.Offset(1, 0)
    [COLOR=darkblue]Loop[/COLOR]
    [COLOR=darkblue]Set[/COLOR] rng = [COLOR=darkblue]Nothing[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] FixColumnG()
    [COLOR=darkblue]Dim[/COLOR] rng [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] txt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] char [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] lastCol [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
 
[COLOR=green]  '============[/COLOR]
[COLOR=green]  'fix column G[/COLOR]
[COLOR=green]  '============[/COLOR]
 
    [COLOR=darkblue]Set[/COLOR] rng = Sheets("Sheet1").Range("G1")
    [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] rng = ""
        lastCol = Sheets("Sheet1").Cells(rng.Row, Columns.Count).End(xlToLeft).Column
        [COLOR=darkblue]For[/COLOR] i = 7 [COLOR=darkblue]To[/COLOR] lastCol
            char = Left(rng, 1)
            [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] IsNumeric(char) [COLOR=darkblue]Then[/COLOR]
                txt = txt & " " & Cells(rng.Row, i).Value
            [COLOR=darkblue]Else[/COLOR]
                txt = txt & " " & Cells(rng.Row, i).Value & Chr(10)
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
        [COLOR=darkblue]Next[/COLOR] i
        [COLOR=darkblue]If[/COLOR] lastCol > 7 [COLOR=darkblue]Then[/COLOR]
            Sheets("Sheet1") _
                .Range(Cells(rng.Row, 8), Cells(rng.Row, lastCol)) _
                .Delete shift:=xlToLeft
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
        rng = txt
        txt = ""
        [COLOR=darkblue]Set[/COLOR] rng = rng.Offset(1, 0)
    [COLOR=darkblue]Loop[/COLOR]
    [COLOR=darkblue]Set[/COLOR] rng = [COLOR=darkblue]Nothing[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

ps I have assumed each new record begins with a "G", i.e., G0003
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,224,585
Messages
6,179,700
Members
452,938
Latest member
babeneker

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top