word document to excel

groove6270 · Nov 24, 2011

greetings everybody

i have searched the forum for a solution to my problem but no luck.
so, I'm pleading for help.
i have more than 200 pages in doc i need to convert id in a table in excel
here is a sample for only 4 items (entries) (i.e. rows)
I made an excel for the first for to show you what i need
and i hope that is possible
ITEM 1A001: WALL SHELF
Quantity: Two (2)
Manufacturer Custom Fabricate
1. Fabricate in accordance with the General and Specific Conditions of these Specifications, as shown on the drawings and as follows:
a. Shelves shall be sized as shown on drawings approximately 1,732mm long.
b. Provide (1) at 1,372mm above finish floor and (1) at 1,676mm above finish floor. Turn ends up, matching upturned back, weld and polished joints.
c. See Elevation “A” Sheet FSA-6 for additional information.
d. See Standard Detail C-1-2.
ITEM 1A002: RECEIVING TABLE W/ SINK
Quantity: One (1)
Manufacturer Custom Fabricate
1. Fabricate in accordance with the General and Specific Conditions of these Specifications, as shown on the drawings and as follows:
a. Table shall be shaped and sized as detailed on the drawings approximately 1,732mm x 762mm x 914mm high to include: one (1) 508mm x 610mm x 238mm deep sink with one (1) Type 3 Faucet and one (1) Type 2 Drain.
b. Utility drawer at left-side end located as shown on drawings.
c. Full length bottom shelf below.
d. See Elevation “A” Sheet FSA-6 for additional information.
e. See Standard Details C-1-1 (C), C-1-1A (2), C-1-3 and C-7-1.
ITEM 1A003: RECEIVING SCALE
Quantity: One (1)
Manufacturer Fairbanks Scales
Model: SERIES III (18" X 24")

1. Unit to be complete with all standard components and/or accessories including the following:
a. Stainless Steel Mobile Stand.
b. The supplier or manufacturer must submit to the purchaser a list of recommended spare parts as an option along with the equipment offer.
ITEM 1A004: STAND-UP DESK
Quantity: One (1)
Manufacturer Lyon
Model: 2250

1. Unit to be complete with all standard components and/or accessories including the following:
a. 915mm high.
b. The supplier or manufacturer must submit to the purchaser a list of recommended spare parts as an option along with the equipment offer.

[FONT=&quot]

[/FONT][FONT=&quot]

[/FONT]

groove6270 · Nov 25, 2011

rosenbe said:

Try this, make sure to update the FileName and SheetName lines that are surrounded by Astrix (*).

Code:

Sub Upload()
' Declairing Variables.
Dim File As Integer    ' Holds the file Index we are working with
Dim FileName As String ' Holds the name of the file we are working with
Dim MyLine As String   ' Holds the line we just read from our file
Dim currRow As Long    ' Holds the current row we are inputting to.
Dim Pos As Long        ' The position of something in a string
Dim sItem As String
Dim sManufacturer As String
Dim sModel As String
Dim sDiscription As String
Dim sQuantity As String
Dim sSheetName As String

'****************************************************************
' You will need to change these lines to reference the text file and sheet you are using
FileName = "C:\...\YourFile.txt"
SheetName = "Sheet1"
'****************************************************************

' Get available file index to use.
File = VBA.FreeFile
' Open our text file.
Open FileName For Input As File
Do Until VBA.EOF(File)
    Line Input #File, MyLine
    MyLine = Application.WorksheetFunction.Trim(MyLine)
    If Strings.UCase$(Strings.Left$(MyLine, 5)) = "ITEM:" Then
        If Not currRow < 1 Then
            ' some code for validation of entries 1 through nth - 1 is needed?
            With ThisWorkbook.Sheets(SheetName)
            .Range("A" & currRow).Value = sItem
            .Range("B" & currRow).Value = sManufacturer
            .Range("C" & currRow).Value = sModel
            .Range("D" & currRow).Value = sDiscription
            .Range("E" & currRow).Value = sQuantity
            End With
        End If
        currRow = currRow + 1
 
        ' Reset our entry variables
        sItem = vbNullString
        sManufacturer = vbNullString
        sModel = vbNullString
        sDiscription = vbNullString
        sQuantity = vbNullString
 
        Pos = Strings.InStr(MyLine, ":")
        If Pos < 1 Then GoTo BadItem
        sItem = Strings.Mid(MyLine, 6, Pos - 6)
        sDiscription = Application.WorksheetFunction.Trim( _
                              Strings.Right$( _
                                    MyLine, _
                                    Strings.Len(MyLine) - Pos _
                                             ) _
                                                         ) & vbNewLine
    ' Quantity
    ElseIf Strings.UCase(Strings.Left$(MyLine, 9)) = "QUANTITY:" Then
        sQuantity = GetQuantityFromString(MyLine)
 
    ' Manufacturer
    ElseIf Strings.UCase(Strings.Left$(MyLine, 12)) = "MANUFACTURER" Then
        sManufacturer = Strings.Mid$(MyLine, 13)
        sManufacturer = Application.WorksheetFunction.Trim(sManufacturer)
 
    ' Model
    ElseIf Strings.UCase(Strings.Left$(MyLine, 6)) = "MODEL:" Then
        sModel = Strings.Mid$(MyLine, 13)
        sModel = Application.WorksheetFunction.Trim(sModel)
    ' Discription (rest of)
    ElseIf Not MyLine = vbNullString Then
        sDescription = sDescription & MyLine & vbNewLine
    End If
Loop
With ThisWorkbook.Sheets(SheetName)
' some code for validation of the final (nth) entry needed?
.Range("A" & currRow).Value = sItem
.Range("B" & currRow).Value = sManufacturer
.Range("C" & currRow).Value = sModel
.Range("D" & currRow).Value = sDiscription
.Range("E" & currRow).Value = sQuantity
End With
Close File
Exit Sub
BadItem:
' Handle bad item exception...
Close File
End Sub

Private Function GetQuantityFromString(ByRef sQuantity As String) As String
    Dim result As String
    Dim i As Long
    Dim b As Boolean
 
    For i = 1 To Strings.Len(sQuantity)
        If Strings.Mid$(sQuantity, i, 1) = ")" Then GoTo NumberFound
        If b Then result = result & Strings.Mid$(sQuantity, i, 1)
        If Strings.Mid$(sQuantity, i, 1) = "(" Then
            b = True
        End If
    Next i
 
NumberFound:
    GetQuantityFromString = result
End Function

after changing to the txt file location
this what happened

Uploaded with ImageShack.us

rosenbe · Nov 25, 2011

Sorry,

The line (13th line in the code):

Dim sSheetName As String

should be...

Dim SheetName As String

groove6270 · Nov 25, 2011

rosenbe said:
Sorry,

The line (13th line in the code):

Dim sSheetName As String

should be...

Dim SheetName As String

same error
maybe this is inappropriate but I'm desperate so if its not much troublesome to you here is the whole file

http://www.2shared.com/document/s2TqQgDQ/4_online.html

thank you for your Patience and efforts

rosenbe · Nov 25, 2011

Alright I have been playing with it, but I have found some logic errors. I did not account for the work "item" in the description. I will have to play with it some more tonight.

groove6270 · Nov 25, 2011

rosenbe said:
Alright I have been playing with it, but I have found some logic errors. I did not account for the work "item" in the description. I will have to play with it some more tonight.

i humbly thank you

rosenbe · Nov 25, 2011

Alright, new approach: In the VB Editor, click on Tools > References... and make sure Microsoft Scripting Runtime is clicked off. Then try this new code:

Code:

Sub Upload()
' Declairing Variables.
Dim FileName As String ' Holds the name of the file we are working with
Dim MyLine As String   ' Holds the line we just read from our file
Dim currRow As Long    ' Holds the current row we are inputting to.
Dim Pos As Long        ' The position of something in a string
Dim sItem As String
Dim sManufacturer As String
Dim sModel As String
Dim sDiscription As String
Dim sQuantity As String
Dim SheetName As String
Dim oFSO As New Scripting.FileSystemObject ' Requires reference to Microsoft Scripting Runtime
Dim oFile As Scripting.TextStream          ' Requires reference to Microsoft Scripting Runtime
'****************************************************************
FileName = "C:\4.txt" ' The file we will be uploading
SheetName = "Sheet1"  ' The sheet we will upload to
currRow = 1           ' The starting line - 1
'****************************************************************
' Open our text file.
On Error GoTo FailedToOpen
Set oFile = oFSO.OpenTextFile(FileName, ForReading)
Do While Not oFile.AtEndOfStream
    MyLine = oFile.ReadLine                              ' Get the next line
    MyLine = Application.WorksheetFunction.Trim(MyLine)  ' Remove any extra spaces
    MyLine = Application.WorksheetFunction.Clean(MyLine) ' Remove any non-diplayable characters
    If Strings.UCase$(Strings.Left$(MyLine, 4)) = "ITEM" Then
        Pos = Strings.InStr(MyLine, ":")
        If Pos < 1 Then GoTo BadItem
        If Not currRow < 1 Then
            ' some code for validation of entries 1 through nth - 1 is needed?
            With ThisWorkbook.Sheets(SheetName)
            .Range("A" & currRow).Value = sItem
            .Range("B" & currRow).Value = sManufacturer
            .Range("C" & currRow).Value = sModel
            .Range("D" & currRow).Value = sDiscription
            .Range("E" & currRow).Value = sQuantity
            End With
        End If
        currRow = currRow + 1
 
        ' Reset our entry variables
        sItem = vbNullString
        sManufacturer = vbNullString
        sModel = vbNullString
        sDiscription = vbNullString
        sQuantity = vbNullString
 
        sItem = Strings.Mid(MyLine, 6, Pos - 6)
        
        ' Fix for 1EXXX converting to a number
        sItem = "=""" & sItem & """"
        
        sDiscription = Application.WorksheetFunction.Trim( _
                              Strings.Right$( _
                                    MyLine, _
                                    Strings.Len(MyLine) - Pos _
                                             ) _
                                                         ) & vbNewLine
    ' Quantity
    ElseIf Strings.UCase(Strings.Left$(MyLine, 9)) = "QUANTITY:" Then
        sQuantity = GetQuantityFromString(MyLine)
 
    ' Manufacturer
    ElseIf Strings.UCase(Strings.Left$(MyLine, 12)) = "MANUFACTURER" Then
        sManufacturer = Strings.Mid$(MyLine, 13)
        sManufacturer = Application.WorksheetFunction.Trim(sManufacturer)
 
    ' Model
    ElseIf Strings.UCase(Strings.Left$(MyLine, 6)) = "MODEL:" Then
        sModel = Strings.Mid$(MyLine, 13)
        sModel = Application.WorksheetFunction.Trim(sModel)
    ' Discription (rest of)
    ElseIf Not MyLine = vbNullString Then
BadItem:
        sDiscription = sDiscription & MyLine & vbNewLine
    End If
Loop

With ThisWorkbook.Sheets(SheetName)
' some code for validation of the final (nth) entry needed?
.Range("A" & currRow).Value = sItem
.Range("B" & currRow).Value = sManufacturer
.Range("C" & currRow).Value = sModel
.Range("D" & currRow).Value = sDiscription
.Range("E" & currRow).Value = sQuantity
End With

FailedToOpen:
oFile.Close
Set oFile = Nothing
Set oFSO = Nothing
End Sub

Private Function GetQuantityFromString(ByRef sQuantity As String) As String
    Dim result As String
    Dim i As Long
    Dim b As Boolean
 
    For i = 1 To Strings.Len(sQuantity)
        If Strings.Mid$(sQuantity, i, 1) = ")" Then GoTo NumberFound
        If b Then result = result & Strings.Mid$(sQuantity, i, 1)
        If Strings.Mid$(sQuantity, i, 1) = "(" Then
            b = True
        End If
    Next i
 
NumberFound:
    GetQuantityFromString = result
End Function

Let me know how it goes.

groove6270 · Nov 26, 2011

it worked like a charm, you saved me from manually inserting all of them.
i don't know what to say to you because THANK YOU isn't nearly enough.
BLESS YOU

groove6270 · Nov 26, 2011

another thing came to my mind.
that is maybe after some time i will get another word document like this (not exactly the same) but it contains the same criteria that i need to put them in 5 columns.
so, is it possible that i can use the same code for it?!

rosenbe · Nov 26, 2011

In theory, yes. The code will do the same thing regardless of the file source, if the criteria is the same, the it will do the same thing to it. But always remember to backup your work just in case some unexpected information is passed and causes unforeseen complications.

groove6270 · Nov 26, 2011

i was working with new excel made by your code
but most of the model numbers either incomplete or not appearing
for example item 1A022 (incomplete) & 1A023 (not showing)
can you check it?

word document to excel

groove6270

New Member

groove6270

New Member

Excel Facts

rosenbe

Board Regular

groove6270

New Member

rosenbe

Board Regular

groove6270

New Member

rosenbe

Board Regular

groove6270

New Member

groove6270

New Member

rosenbe

Board Regular

groove6270

New Member

Similar threads

Forum statistics

Share this page

word document to excel

New Member

New Member

Excel Facts

Board Regular

New Member

Board Regular

New Member

Board Regular

New Member

New Member

Board Regular

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock