CODEWITHSUNDEEP
vbaexcelms-word
Frederick
Frederick

Reputation: 137

Copy Data from Word to Excel based on Headings and surrounding text

I am given a Word file which contains 30 cases every week. I have to get data and place them in columns in an Excel file.

The Word file looks like this: https://i.sstatic.net/u3HI9.jpg

I am thinking of two approaches:

  1. Add tags on the titles and citations since they don't have headings or anything else that could distinguish them: /title A vs. B and /cite 123 A.B.C. 234 (yellow and purple highlight in the pic).
    Take the paragraph after the /title and /cite.

  2. Look for the whole paragraph after "OVERVIEW:" since this data is distinguished by this string.

Summary:
I want to copy all case titles (yellow) into a column in an existing Excel sheet, copy all the citations (purple) into another column, copy all overviews (red) into another column, etc.

Sample Excel and Word file used: file

Note: case names and arrangement in the file attached above will not match since I have already edited and sorted the Excel file. I just need the macro to copy the data and then I would sort it later.

Upvotes: 1

Views: 7126

Answers (2)

ASH
ASH

Reputation: 20342

I would say that you need to get everything into Excel, as such.

Sub Sentence_Click()

Dim num As Variant
'Microsoft Word object
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
'Word document object
Dim WordNam As String
WordNam = "C:\Users\Excel\Desktop\September Week 1 2017.docx"

'Open word document
objWord.Documents.Open WordNam
j = 1
n = objWord.Documents(WordNam).Paragraphs.Count
For Each num In Array(7, 13, 23)
For i = 1 To n
    If i = num Then
        ThisWorkbook.Worksheets(1).Cells(j, 1) = objWord.Documents(WordNam).Paragraphs(i)
        Debug.Print num
        j = j + 1
    End If
Next i
Next num
'Close objects
objWord.Documents.Close
objWord.Quit SaveChanges:=wdDoNotSaveChanges


End Sub

Then parse out the data in Excel, any way you choose.

As you can see, I am importing based on paragraph number, and not based on color. I think you added those colors; I don't think the document comes to you like that.

Upvotes: 2

Harassed Dad
Harassed Dad

Reputation: 4714

I'm not going to write the code for you, but to get you started this code, if pasted into a vb module in Word, will copy any selected text in the current word document into a blank spreadsheet in excel.

Sub copytext2XL()
Dim r As Range 'nb this is a Word range, not an Excel range
Dim xl
Dim wb, ws, xlr
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set wb = xl.workbooks.Add
Set ws = wb.worksheets(1)
Set xlr = ws.Range("a1")

Set r = Selection.Range
 r.Copy
 xlr.PasteSpecial 3

End Sub

Upvotes: 0

Related Questions