Need to Pull Specific Data/Text from Word to Specific Cells in Excel

[greenbcz]

Hi everyone,

I am a newbie to Excel VBA. I need to accomplish an important automation task using Excel VBA. It requires pulling specific data/text from word file to excel sheet. Please see attached sample files.

The highlighted date and each date under it in word file needs to be extracted and put into the 'PO issue date' column in excel first sheet. Similarly, each part number (highlighted) in word file needs to be put it into the 'Funai Part No' column. Similarly, the quantity in word file under 'TOTAL' needs to be put into the 'Required Qty' column and PO number in word file (Lastrow end value - 70525003) needs to be put into the 'PO Number' column. This PO number will be similar for all other dates as well entered in excel.

I shall be grateful if any one can help as soon as possible. Thank you!

[macropod]

Is this required for just a single selected file, a group of selected files, or a whole folder of files at a time?

I note that your sample document consists of what appears to be a plain text file. There is no need to convert them to Word files for processing. Perhaps you could clarify your needs in that regard.

[greenbcz]

Hi macropod,

Thank you for your reply. The excel macro will take this one word file as input and pull its selected data and paste it in excel first sheet as per requirements already shared.
I know that data is based on text file but still macro should be able to get data from this file. Please help as soon as possible. Thanks again!

[macropod]

Try the following. It works with the data as supplied, but I note that the existing data in your workbook are quite different. You could check the file path & name, too.

Sub GetData()
Application.ScreenUpdating = False
'Note: A reference to the Word library must be set, via Tools|References
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim xlSht As Worksheet, lRow As Long, r As Long, i As Long
Dim StrDocNm As String, StrPart As String, StrOrder As String
StrDocNm = "C:\Users\" & Environ("UserName") & "\Documents\Downloads\asla\MR713_DYNACAST_S08 (1).docx"
If Dir(StrDocNm) = "" Then Exit Sub
Set xlSht = ThisWorkbook.Worksheets("PurchaseOrder")
lRow = xlSht.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).row + 1: r = lRow
Set wdDoc = wdApp.Documents.Open(Filename:=StrDocNm, ReadOnly:=True, AddToRecentFiles:=False)
wdApp.Visible = True
With wdDoc
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
.Text = "*(PART)"
.Replacement.Text = "\1"
.Execute Replace:=wdReplaceOne
.Text = "(PART [A-Z0-9]@-[0-9]{1,})*DATE*^13"
.Replacement.Text = "\1^p"
.Execute Replace:=wdReplaceAll
.Text = "^13( [0-9]{1,2}/[0-9]{2}/[0-9]{2}[!^13]@[0-9]{1,}>)[!^13]{1,}"
.Replacement.Text = "^p\1"
.Execute Replace:=wdReplaceAll
.Text = "[-]{7}CD*^13*PAGE*([-]@^13)"
.Replacement.Text = "\1"
.Execute Replace:=wdReplaceAll
.Text = "--DATE*^13*[-]@^13{1,}"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
.Text = "^13 ([0-9]{1,2}/[0-9]{2}/[0-9]{2})"
.Replacement.Text = "^p\1"
.Text = "^13 ([0-9]{1,2}/[0-9]{2}/[0-9]{2})[!^13]@([0-9]{1,}>)"
.Replacement.Text = "^p\1^t\2"
.Execute Replace:=wdReplaceAll
.Forward = False
.Text = "([0-9]{1,2}/[0-9]{2}/[0-9]{2}^t[0-9]{1,}>)*DELIVERY*[ ]{1,}([A-Z0-9\-]{8,12})"
.Replacement.Text = "\1^p\2"
.Execute Replace:=wdReplaceOne
End With
For i = 1 To .Paragraphs.Count
If Trim(.Paragraphs(i).Range.Words.First) = "PART" Then
StrPart = Split(Split(.Paragraphs(i).Range.Text, " ")(1), vbCr)(0)
ElseIf InStr(.Paragraphs(i).Range.Text, vbTab) > 0 Then
xlSht.Range("D" & r).Value = Split(.Paragraphs(i).Range.Text, vbTab)(0)
xlSht.Range("E" & r).Value = StrPart
xlSht.Range("F" & r).Value = Split(Split(.Paragraphs(i).Range.Text, vbTab)(1), vbCr)(0)
r = r + 1
ElseIf InStr(.Paragraphs(i).Range.Text, vbTab) = 0 Then
If Len(.Paragraphs(i).Range.Text) > 1 Then
StrOrder = Split(.Paragraphs(i).Range.Text, vbCr)(0)
End If
End If
Next
For i = lRow To r - 1
xlSht.Range("B" & i).Value = StrOrder
xlSht.Range("A" & i).Value = xlSht.Range("A" & i - 1).Value + 1
Next
.Close SaveChanges:=False
End With
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set xlSht = Nothing
Application.ScreenUpdating = True
End Sub

[greenbcz]

Hi macropod,

Thank you so much. Your code is working almost completely right. Its just that PO number is entered into incorrect column, i.e. B whereas it should be entered in column C.
Please suggest correction in this regards.
Secondly if I need selected data to be auto-entered in excel first sheet named 'Funai_PO_Summary', what change in code would I make?
Thanks again!

[macropod]

PO number is entered into incorrect column, i.e. B whereas it should be entered in column C.
Please suggest correction in this regards.
I'd have thought that would be pretty obvious from reading the code. Change:
xlSht.Range("B" & i).Value = StrOrder
to:
xlSht.Range("C" & i).Value = StrOrder

I need selected data to be auto-entered in excel first sheet named 'Funai_PO_Summary', what change in code would I make?
I'd have thought that too would be pretty obvious from reading the code. Change:
Set xlSht = ThisWorkbook.Worksheets("PurchaseOrder")
to:
Set xlSht = ThisWorkbook.Worksheets("Funai_PO_Summary")

[greenbcz]

Hi macropod,

Thanks a lot for your support and guidance! Appreciated.