Import complicated data from word to excel

[Frozsh]

Hi all

I am new to this forum and i have been trying some other threads importing word data to excel but finding code to help me extract this numbers keeps me struggling...


Basically: I have 10 word documents that contain the same data for different location.. I have a sample word input and a sample excel output.

I tried my best but my best wasn't good enough..

any help much appreciated..

thanks so much

[macropod]

See the attached workbook. It contains a macro named 'GetData'. Run that. Note that the macro includes a browser, so all you need to do is to point it to the folder containing the Word files.

[Frozsh]

i went to tools and references and i found out that
MISSING: Microsoft Word 14.0 Object Library

what should i do :(

im using microsoft 2007 and i saw on the reference is Microsoft Word 12.0 Object Library is present

now at the moment, i am downloading microsoft 2010 for this project to be tested and run.

[Frozsh]

I have tried it on microsoft 2010 and it worked!! flawless!
Thank you so much macropod!! many many thanks!
Im so glad :yes:yes
cheers for you sir :beerchug:

[macropod]

Actually, the code won't be 'flawless' just yet - you need to change:

strFile = Dir()
Wend
wdApp.Quit
With xlWkSht
.Cells(LRow + 1, 1).Value = .Cells(LRow, 6).Value
.Cells(LRow, 6).Value = .Cells(LRow, 5).Value
.Cells(LRow, 5).Value = .Cells(LRow, 4).Value
.Cells(LRow, 4).Value = .Cells(LRow, 7).Value
.Cells(LRow + 1, 5).Value = .Cells(LRow, 10).Value
.Cells(LRow, 10).Value = vbNullString
.Cells(LRow + 1, 6).Value = .Cells(LRow, 11).Value
.Cells(LRow, 11).Value = vbNullString
.Range("G1:K1").EntireColumn.Delete
.Range("B1:B" & LRow).Value = .Range("B1:K" & LRow).Value
.Range("A1:H1").EntireColumn.AutoFit
End With
to:

With xlWkSht
.Cells(LRow + 1, 1).Value = .Cells(LRow, 6).Value
.Cells(LRow, 6).Value = .Cells(LRow, 5).Value
.Cells(LRow, 5).Value = .Cells(LRow, 4).Value
.Cells(LRow, 4).Value = .Cells(LRow, 7).Value
.Cells(LRow + 1, 5).Value = .Cells(LRow, 10).Value
.Cells(LRow, 10).Value = vbNullString
.Cells(LRow + 1, 6).Value = .Cells(LRow, 11).Value
.Cells(LRow, 11).Value = vbNullString
.Range("G1:K1").EntireColumn.Delete
.Range("B1:B" & LRow).Value = .Range("B1:K" & LRow).Value
.Range("A1:H1").EntireColumn.AutoFit
End With
LRow = LRow + 1
strFile = Dir()
Wend
wdApp.Quit

[macropod]

Or perhaps:

With xlWkSht
.Cells(LRow + 1, 1).Value = .Cells(LRow, 6).Value
.Cells(LRow, 6).Value = .Cells(LRow, 5).Value
.Cells(LRow, 5).Value = .Cells(LRow, 4).Value
.Cells(LRow, 4).Value = .Cells(LRow, 7).Value
.Cells(LRow + 1, 5).Value = .Cells(LRow, 10).Value
End With
LRow = LRow + 1
strFile = Dir()
Wend
With xlWkSht
.Range("G1:K1").EntireColumn.Delete
.Range("B1:B" & LRow).Value = .Range("B1:K" & LRow).Value
.Range("A1:H1").EntireColumn.AutoFit
End With
wdApp.Quit
Re your comment about 'MISSING: Microsoft Word 14.0 Object Library'. For Office 2007, simply replace the reference with one to the Microsoft Word 12.0 Object Library.

[Frozsh]

thanks i would try those out right now. brb

im now using ms 2010 :)

[Frozsh]

I added a row to distinguish each file



End With
LRow = LRow + 2
strFile = Dir()
Wend


together with the code above this is the output file. I noticed that the distance though was not on the right cell on the last 2nd line of each file

[macropod]

Sorry about that. I hadn't fully allowed for the fact my code outputs the data with a different column order to what you originally posted. The following changes should put the data for the penultimate and last rows in each block in the correct columns.


With xlWkSht
.Cells(LRow + 1, 1).Value = .Cells(LRow, 6).Value
.Cells(LRow, 6).Value = .Cells(LRow, 7).Value
.Cells(LRow + 1, 4).Value = .Cells(LRow, 10).Value
.Cells(LRow + 1, 5).Value = .Cells(LRow, 11).Value
End With
strFile = Dir()
LRow = LRow + 2
Wend
With xlWkSht
.Range("G1:K1").EntireColumn.Delete
.Range("B1:B" & LRow).Value = .Range("B1:F" & LRow).Value
.Range("A1:F1").EntireColumn.AutoFit
End With
wdApp.Quit

[Frozsh]

thank you so much! i wish i could learn how you did that so i too can make my own vba script in the future.

i got another sample here. what i did was convert doc to txt then to xls space delimeted and deleted and moved some cells.


thank you :yes

can you create a macro for this too

[macropod]

Try the attached. FWIW, most of the code in both solutions involve using Word's wildcard Find/Replace functions. You can learn and use those without having to learn VBA.

[Frozsh]

what if i'd like to autofill the first row without altering its numbering to make that like the one below
e.g.


before
after


S-50=PPM 18
S-50=PPM 18



S-50=PPM 18



S-50=PPM 18


S-51
S-51



S-51



S-51



S-51


S-52=HUB
S-52=HUB



S-52=HUB



S-52=HUB


S-55=HUB
S-55=HUB



S-55=HUB



S-55=HUB


i will try to learn from those codes the best as i can :yes
and thank you for the time sir :bow:

[macropod]

Change:

With xlWkSht
.Range("A1:F1").EntireColumn.AutoFit
.Range("A1").ActivateWith xlWkSht
End With
to:

With xlWkSht
.Range("A1:F1").EntireColumn.AutoFit
.Range("A1").ActivateWith xlWkSht
For LRow = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
If .Cells(LRow, 2).Value <> "" Then
If .Cells(LRow, 1).Value = "" Then
.Cells(LRow, 1).Value = .Cells(LRow - 1, 1).Value
End If
End If
Next
End With
PS: You can delete the workbook's 'module1' code module - it's not needed and merely contains some left-over development code.

[Frozsh]

It worked :yes. Just modded some changes to the code. This is the last request ill made for this thread ^^
can you add a code that will add the Case to the next cell right to the last column just beside the easting but heading not included : pray2:



Before


After



Eastings

Eastings



478,277.413

478,277.413
Case 5



478,440.471

478,440.471
Case 5


478,200.645

478,200.645
Case 5


478,440.471

478,440.471
Case 5


478,277.413

478,277.413
Case 5

[macropod]

There seems to be some serious scope creep going on here ...

Change the final 'With xlWkSht ... End With' block to:

With xlWkSht
.Range("A1:F1").EntireColumn.AutoFit
.Range("A1").Select
For LRow = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
If .Cells(LRow, 2).Value <> "" Then
If .Cells(LRow, 1).Value = "" Then
.Cells(LRow, 1).Value = .Cells(LRow - 1, 1).Value
End If
End If
If .Cells(LRow, 1).Value = "CASE" Then
StrOut = "CASE " & .Cells(LRow, 2).Value
ElseIf IsNumeric(.Cells(LRow, 6).Value) = True Then
If .Cells(LRow, 6).Value <> "" Then .Cells(LRow, 7).Value = StrOut
End If
Next
End With

[Frozsh]

I'm so sorry for the inconvenience. i thought of making a new thread for the other kinds of help that was far off and new maybe, but i put it here. sorry.
Thank you sir for everything and thanks for the inspiration. Bless you and advanced merry Christmas! :)

[Frozsh]

hello macropod, is it ok if i add another sample.. i feel like i would :banghead:

[Frozsh]

Macro, i learned and somehow tried my best. All is well.
The only lacking data now is the Area and i cant get rid of the first empty column beside the numbers.

:yes

[Frozsh]

Update: I have successfully and flawlessly extracted all the data and put them into the right places. Wildcard really "is" interesting.
The problem was solved. Thanks Macropod for the inputs :beerchug: