Again: word document to excel

groove6270

New Member
Joined
Nov 24, 2011
Messages
19
Hi
i have this word document with repetition pattern i need to convert it to excel. i had this problem before and it was solved by rosenbe here
http://www.mrexcel.com/forum/showthread.php?t=594601
and now i have very much similar file need converting the same way, so i tried to alternate the code given by rosenbe but no use. can someone help me here?
here is a snap shot to the word doc



and here is a sample of how i need it



last time this code did it

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, 7)
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


no matter what i try, it fails
please help
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

Forum statistics

Threads
1,224,226
Messages
6,177,275
Members
452,765
Latest member
Erka Gizli

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