Word macro to find and paste specific text from a word file into new excel file

John Brito · #1 12-16-2022, 07:48 PM

Hi May I request you all to help me for a macro to find and paste specific text from a word file into a new excel file.

The macro should copy any name which is appear either below or next to a text says "Name of person" however, do not pick any other rest of the words from the next paragraph onwards. Then paste the text nto a new Excel file.

Example:

"Name of person Dr. Peter Paul G"
"Voluntarily retired"

So, the macro should copy and paste into Excel only the word Dr. Peter Paul G

I have so many similar instances in my word document, so pls help me to extract

gmayor · #2 12-16-2022, 10:07 PM

The following will do what you asked based on your example:

Code:

Sub CopyNamesToExcel()
Dim oRng As Range
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim xlCell As Object
Dim i As Integer, j As Integer
Dim sName As String
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Sheets(1)
    xlApp.Visible = True
    Set xlCell = xlSheet.Range("A1")
    xlCell.value = "Name"
    j = 2
    For i = ActiveDocument.Paragraphs.Count To 1 Step -1
        If InStr(1, ActiveDocument.Paragraphs(i).Range.Text, "Name of person") > 0 Then
            Set oRng = ActiveDocument.Paragraphs(i).Range
            oRng.MoveStartUntil "n"
            oRng.Start = oRng.Start + 1
            oRng.End = oRng.End - 1
            sName = Trim(Replace(oRng.Text, Chr(34), ""))
            Set xlCell = xlSheet.Range("A" & j)
            xlCell.value = sName
            j = j + 1
        End If
    Next i
End Sub

John Brito · #3 12-16-2022, 11:07 PM

Thank you Sir for the quick help

When I run the macro, the name not extracted fully. I herewith attached example files, the word source and how the expected Excel output file would be.

Thanks in advance.

John

gmayor · #4 12-17-2022, 12:15 AM

Your sample documents do not reflect the details you provided so it is no wonder it did not work. Based on your revised example the following will work and will also allow for the spelling error.

Code:

Sub CopyNamesToExcel()
Dim oTable As Table
Dim oRng As Range
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim xlCell As Object
Dim i As Integer, j As Integer
Dim sName As String
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Sheets(1)
    xlApp.Visible = True
    'Set xlCell = xlSheet.Range("A1")
    'xlCell.value = "Name"
    'j = 2
    j = 1
    For Each oTable In ActiveDocument.Tables
        Set oRng = oTable.Cell(1, 2).Range
        oRng.End = oRng.End - 1
        If InStr(1, oRng.Text, "NAMES OF PERSON") > 0 Then
            sName = Replace(oRng.Text, "NAMES OF PERSON", "")
            sName = Replace(sName, "VOLUNTARIY RETIRED", "")    '? Spelling
            sName = Replace(sName, "VOLUNTARILY RETIRED", "")
            sName = Replace(sName, Chr(13), "")
            Set xlCell = xlSheet.Range("A" & j)
            xlCell.value = Trim(sName)
            j = j + 1
        End If
    Next oTable
End Sub

John Brito · #5 12-17-2022, 12:36 AM

It works now.
Thank you very much for the quick and good help you have provided. I am very grateful for your help.

Thanks,
John.

John Brito · #6 12-21-2022, 03:04 AM

Hi gmayor,

Greetings to you, I have applied the same macro in another word document recently received.

The document is bit weird and the previous macro is not supporting to extract the Name of the person into an Excel.

When I run the macro it shows Run-time error '5941', not sure how to resolve this, May I request you to check and provide help on this please.

I have attached the document herewith

John

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Find a Specific word in doc file using VBA	Priyantha Gamini	Word VBA	7	12-14-2022 05:18 AM
Macro to check the existence of a word docx file and create a new word file with specific content.	staicumihai	Word VBA	14	11-15-2016 01:42 AM
Macro to highlight repeated words in word file and extract into excel file	aabri	Word VBA	1	06-14-2015 07:20 AM
needles and haystacks – how to find that one .doc file containing a specific word? Windows 7	eNGiNe	Word	0	04-01-2015 11:15 PM
Word Macro: Save file as text with current file name	jabberwocky12	Word VBA	2	10-22-2010 12:23 PM