Solved

Export data from word to Excel in special format....

Posted on 2011-03-14
9
245 Views
Last Modified: 2013-11-05
Hello. I have data in a text file needs to be exported into Excel. Sounds simple and perhaps it is for the right person...The data is in a single column in the text file in a single column:


 
ALABAMA ADVANCED CRIMINAL JUSTICE ACADEMY
740 Mildred St
Montgomery, Alabama 36104  
Phone: 334-240-4824
Fax: 334-240-4539
 
ALABAMA CANINE TRAINING CENTER
29 Rice Valley Rd Ne
Tuscaloosa, Alabama 35406  
Phone: 205-391-2488
Fax: 205-391-2492

 
ALASKA DEPT OF SAFETY TRAINING ACADEMY
877 Sawmill Creek Rd
Sitka, Alaska 99835  
Phone: 907-747-6611
Fax: 907-747-5606
 
ALASKA POLICE STANDARDS COUNCIL
450 Whittier St
Juneau, Alaska 99811  
Phone: 907-465-4378
Fax: 907-465-3263
 



Here is what it would need to look like in Excel. The top line are headers for each column.:

Agency_name    address     address2    ph_num     fax_num


Any ideas?
0
Comment
Question by:chancer74
  • 4
  • 3
  • 2
9 Comments
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 35130538
Some clarifications requested:

1) Is this a text file, or a Word document?  Your question is ambiguous on that point.

2) Will there ever be >2 address lines?  E.g.:

ALASKA POLICE STANDARDS COUNCIL
450 Whittier St
Second Floor
Juneau, Alaska 99811  
Phone: 907-465-4378
Fax: 907-465-3263

3) Is the phone number ALWAYS preceded by "Phone: "?  The fax number by "Fax: "?

4) Why not separate the city, state, and ZIP?  It can be done, and it will make your data much cleaner
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 500 total points
ID: 35130557
chancer74: Your Thread title says that you want to export data from word but the body of the thread says that it is a text file. I am going ahead and giving you a code sample for the text file.

Please change the path of the Sample.Txt in the code below. Also not the spacing between two records. It shouldn't be more than 1.

After you open the text file, simply run the macro Sample() and the data will be exported to Sheet1.

Sid

Code Used

Sub Sample()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim MyData As String, strData() As String, Search As String
    Dim i As Long, lastRowWs1 As Long, lastRowWs2 As Long
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets.Add: ws2.Name = "Temp"
    
    '~~> Change path of text file here
    Open "C:\Sample.Txt" For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)
    
    For i = 0 To UBound(strData())
        ws2.Range("A" & i + 1).Value = strData(i)
    Next
    
    ws1.Range("A1").Value = "Agency_name"
    ws1.Range("B1").Value = "address"
    ws1.Range("C1").Value = "address2"
    ws1.Range("D1").Value = "ph_num"
    ws1.Range("E1").Value = "fax_num"
    
    lastRowWs2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    
    lastRowWs1 = 2
    
    For i = 1 To lastRowWs2 Step 6
        ws1.Range("A" & lastRowWs1).Value = ws2.Range("A" & i).Value
        ws1.Range("B" & lastRowWs1).Value = ws2.Range("A" & i + 1).Value
        ws1.Range("C" & lastRowWs1).Value = ws2.Range("A" & i + 2).Value
        ws1.Range("D" & lastRowWs1).Value = ws2.Range("A" & i + 3).Value
        ws1.Range("E" & lastRowWs1).Value = ws2.Range("A" & i + 4).Value
        lastRowWs1 = lastRowWs1 + 1
    Next i
    
    Application.DisplayAlerts = False
    ws2.Delete
    Application.DisplayAlerts = False
    
    Set ws2 = Nothing
End Sub

Open in new window

Export-data.xls
Sample.txt
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35130563
Cross over.

Sorry Patrick.

Sid
0
Optimizing Cloud Backup for Low Bandwidth

With cloud storage prices going down a growing number of SMBs start to use it for backup storage. Unfortunately, business data volume rarely fits the average Internet speed. This article provides an overview of main Internet speed challenges and reveals backup best practices.

 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35130603
>>>>After you open the text file, simply run the macro Sample() and the data will be exported to Sheet1.

chancer74: I meant after you open the EXCEL file, simply run the macro Sample() and the data will be exported to Sheet1.

Sid
0
 

Author Comment

by:chancer74
ID: 35132076
1) Is this a text file, or a Word document?  Your question is ambiguous on that point.
Text
2) Will there ever be >2 address lines?  E.g.:
No
ALASKA POLICE STANDARDS COUNCIL
450 Whittier St
Second Floor
Juneau, Alaska 99811  
Phone:             907-465-4378      
Fax: 907-465-3263


3) Is the phone number ALWAYS preceded by "Phone: "?  The fax number by "Fax: "?
yes, yes
4) Why not separate the city, state, and ZIP?  It can be done, and it will make your data much cleaner.
Wouldn't mind....

The file is a text file as I saved it as such from Word.  Thx.
0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 35133010
I have not tested Sid's suggestions, so please be sure to check them out.  In the meantime, this handles the data according to your original schema:



Sub GetAddrInfo()
    
    Dim BigArr As Variant
    Dim Results() As Variant
    Dim fso As Object
    Dim ts As Object
    Dim FilePath As Variant
    Dim Counter As Long
    Dim Field As Long
    Dim Test As String
    
    FilePath = Application.GetOpenFilename("Text files (*.txt), *.txt", , "Select file to process", , False)
    If FilePath = False Then
        MsgBox "No file selected; aborting", vbCritical, "No soup for you!"
        Exit Sub
    End If
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile(FilePath)
    BigArr = ts.ReadAll
    ts.Close
    Set ts = Nothing
    Set fso = Nothing
    
    Do Until InStr(1, BigArr, " " & vbCrLf) = 0
        BigArr = Replace(BigArr, " " & vbCrLf, vbCrLf)
    Loop
    Do Until InStr(1, BigArr, vbCrLf & vbCrLf & vbCrLf) = 0
        BigArr = Replace(BigArr, vbCrLf & vbCrLf & vbCrLf, vbCrLf & vbCrLf)
    Loop
    BigArr = Split(BigArr, vbCrLf)
    
    ReDim Results(1 To 5, 1 To 1) As Variant
    Results(1, 1) = "Agency_name"
    Results(2, 1) = "address"
    Results(3, 1) = "address2"
    Results(4, 1) = "ph_num"
    Results(5, 1) = "fax_num"
    
    For Counter = 0 To UBound(BigArr)
        Test = BigArr(Counter)
        If LCase(Test) Like "phone:*" Then
            Test = Trim(Mid(Test, 7))
        ElseIf LCase(Test) Like "fax:*" Then
            Test = Trim(Mid(Test, 5))
        End If
        If Field = 0 And Test <> "" Then
            Field = 1
            ReDim Preserve Results(1 To 5, 1 To UBound(Results, 2) + 1) As Variant
        ElseIf Field > 0 And Test <> "" Then
            Field = Field + 1
        Else
            Field = 0
        End If
        If Field > 0 Then
            Results(Field, UBound(Results, 2)) = Test
        End If
    Next
    
    Workbooks.Add
    Cells(1, 1).Resize(UBound(Results, 2), UBound(Results, 1)).Value = Application.Transpose(Results)
    Columns.AutoFit
    
    MsgBox "Done"
    
End Sub

Open in new window


I will see about breaking up the second address line now.

Patrick
0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 35133095
OK, and this is splitting up address2 into city, state, and ZIP:



Sub GetAddrInfo()
    
    Dim BigArr As Variant
    Dim Results() As Variant
    Dim fso As Object
    Dim ts As Object
    Dim FilePath As Variant
    Dim Counter As Long
    Dim Field As Long
    Dim Test As String
    Dim CommaPos As Long
    Dim LastSpacePos As Long
    
    FilePath = Application.GetOpenFilename("Text files (*.txt), *.txt", , "Select file to process", , False)
    If FilePath = False Then
        MsgBox "No file selected; aborting", vbCritical, "No soup for you!"
        Exit Sub
    End If
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile(FilePath)
    BigArr = ts.ReadAll
    ts.Close
    Set ts = Nothing
    Set fso = Nothing
    
    Do Until InStr(1, BigArr, " " & vbCrLf) = 0
        BigArr = Replace(BigArr, " " & vbCrLf, vbCrLf)
    Loop
    Do Until InStr(1, BigArr, vbCrLf & vbCrLf & vbCrLf) = 0
        BigArr = Replace(BigArr, vbCrLf & vbCrLf & vbCrLf, vbCrLf & vbCrLf)
    Loop
    BigArr = Split(BigArr, vbCrLf)
    
    ReDim Results(1 To 7, 1 To 1) As Variant
    Results(1, 1) = "Agency_name"
    Results(2, 1) = "address"
    Results(3, 1) = "city"
    Results(4, 1) = "state"
    Results(5, 1) = "zip"
    Results(6, 1) = "ph_num"
    Results(7, 1) = "fax_num"
    
    For Counter = 0 To UBound(BigArr)
        Test = BigArr(Counter)
        If LCase(Test) Like "phone:*" Then
            Test = Trim(Mid(Test, 7))
        ElseIf LCase(Test) Like "fax:*" Then
            Test = Trim(Mid(Test, 5))
        End If
        If Field = 0 And Test <> "" Then
            Field = 1
            ReDim Preserve Results(1 To 7, 1 To UBound(Results, 2) + 1) As Variant
        ElseIf Field > 0 And Test <> "" Then
            Field = Field + 1
        Else
            Field = 0
        End If
        Select Case Field
            Case 1, 2
                Results(Field, UBound(Results, 2)) = Test
            Case 3
                CommaPos = InStr(1, Test, ",")
                LastSpacePos = InStrRev(Test, " ")
                Results(3, UBound(Results, 2)) = Left(Test, CommaPos - 1)
                Results(4, UBound(Results, 2)) = Trim(Mid(Test, CommaPos + 1, LastSpacePos - CommaPos))
                Results(5, UBound(Results, 2)) = Mid(Test, LastSpacePos + 1)
            Case 4, 5
                Results(Field + 2, UBound(Results, 2)) = Test
            Case Else
                ' do nothing!
        End Select
    Next
    
    Workbooks.Add
    Cells(1, 1).Resize(UBound(Results, 2), UBound(Results, 1)).Value = Application.Transpose(Results)
    Columns.AutoFit
    
    MsgBox "Done"
    
End Sub

Open in new window

0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35134496
Nice one Patrick :)

chancer74: Did you get a chance to test what I posted?

Sid
0
 

Author Closing Comment

by:chancer74
ID: 35243723
Thanks for your help
0

Featured Post

Master Your Team's Linux and Cloud Stack!

The average business loses $13.5M per year to ineffective training (per 1,000 employees). Keep ahead of the competition and combine in-person quality with online cost and flexibility by training with Linux Academy.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
VBA code to open new email message (Contact Us) 3 32
Excel Formula 5 45
Alphabetical Order for Letters 2 21
Excel calculate based on 'x' in column 2 25
Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

773 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question