Consulting

Results 1 to 20 of 20

Thread: Macro for replacing EXCEL data into WORD

  1. #1

    Macro for replacing EXCEL data into WORD

    Hello,

    I'm completely new using VBA, macros and programming as a whole. I'm trying to make a macro that replaces some predefined words from a *.doc document with values (in this case words) of a cell from an excel-sheet.

    My aim is to have an automation for an excel-sheet with the data as shown below. And a form/application/some ms-word document that needs to be fill out.

    FIST_NAME MIDDLE_NAME LAST_NAME D.O.B

    The macro will just replace the values entered in the excel-sheet to the *.doc document.

    Can someone please help me with this? Thank you.

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,091
    Location
    Depending on what you're trying to achieve, you may not need a macro at all.

    If, for example, you're trying to produce multiple letters or a report using the Excel data, a mailmerge in Word, with the Excel workbook as the data source, might meet your needs.

    Alternatively, if you just want the Word document to reflect whatever's in a particular set of Excel cells at the time, you could use LINK fields in the Word document.

    What you've described is really better suited to situations where you might have a Find/Replace list in Excel that you want to process in one or more documents.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  3. #3
    Thank you for the reply. You are absolutely right. How can I do a find/replace list in excel from a word file?

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,091
    Location
    The following Word macro allows you to use an Excel Workbook to hold Find/Replace strings as the source for a large-scale Find/Replace operation. In this example, the macro finds the strings referred to in column A and replaces them with the strings referred to in column B. The user has the option to skip particular found strings, or to cancel the process altogether. Comments in the code show how to make the processing automatic (ie no user intervention). The bulk of the code (around 80%) is for managing the Excel session.
    Sub BulkFindReplace() 
        Application.ScreenUpdating = True 
        Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String 
        Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean 
        Dim xlFList As String, xlRList As String, i As Long, Rslt 
        StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\Workbook Name.xls" 
        StrWkSht = "Sheet1" 
        If Dir(StrWkBkNm) = "" Then 
            MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation 
            Exit Sub 
        End If 
         ' Test whether Excel is already running.
        On Error Resume Next 
        bStrt = False ' Flag to record if we start Excel, so we can close it later.
        Set xlApp = GetObject(, "Excel.Application") 
         'Start Excel if it isn't running
        If xlApp Is Nothing Then 
            Set xlApp = CreateObject("Excel.Application") 
            If xlApp Is Nothing Then 
                MsgBox "Can't start Excel.", vbExclamation 
                Exit Sub 
            End If 
             ' Record that we've started Excel.
            bStrt = True 
        End If 
        On Error GoTo 0 
         'Check if the workbook is open.
        bFound = False 
        With xlApp 
             'Hide our Excel session
            If bStrt = True Then .Visible = False 
            For Each xlWkBk In .Workbooks 
                If xlWkBk.FullName = StrWkBkNm Then ' It's open
                    Set xlWkBk = xlWkBk 
                    bFound = True 
                    Exit For 
                End If 
            Next 
             ' If not open by the current user.
            If bFound = False Then 
                 ' Check if another user has it open.
                If IsFileLocked(StrWkBkNm) = True Then 
                     ' Report and exit if true
                    MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use" 
                    If bStrt = True Then .Quit 
                    Exit Sub 
                End If 
                 ' The file is available, so open it.
                Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm) 
                If xlWkBk Is Nothing Then 
                    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation 
                    If bStrt = True Then .Quit 
                    Exit Sub 
                End If 
            End If 
             ' Process the workbook.
            With xlWkBk.Worksheets(StrWkSht) 
                 ' Find the last-used row in column A.
                 ' Add 1 to get the next row for data-entry.
                iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
                 ' Output the captured data.
                For i = 1 To iDataRow 
                     ' Skip over empty fields to preserve the underlying cell contents.
                    If Trim(.Range("A" & i)) <> vbNullString Then 
                        xlFList = xlFList & "|" & Trim(.Range("A" & i)) 
                        xlRList = xlRList & "|" & Trim(.Range("B" & i)) 
                    End If 
                Next 
            End With 
            If bFound = False Then xlWkBk.Close False 
            If bStrt = True Then .Quit 
        End With 
         ' Release Excel object memory
        Set xlWkBk = Nothing: Set xlApp = Nothing 
         'Process each word from the F/R List
        For i = 1 To UBound(Split(xlFList, "|")) 
            With ActiveDocument.Range 
                With .Find 
                    .ClearFormatting 
                    .Replacement.ClearFormatting 
                    .MatchWholeWord = True 
                    .MatchCase = True 
                    .Wrap = wdFindStop 
                    .Text = Split(xlFList, "|")(i) 
                    .Execute 
                     'To automatically change the found text:
                     '• comment-out/delete the previous line and the Do While Loop
                     '• uncomment the next two lines
                     '.Replacement.Text = Split(xlRList, "|")(i)
                     '.Execute Replace:=wdReplaceAll
                End With 
                 'Ask the user whether to change the found text
                Do While .Find.Found 
                    .Duplicate.Select 
                    Rslt = MsgBox("Replace this instance of:" & vbCr & _ 
                    Split(xlFList, "|")(i) & vbCr & "with:" & vbCr & _ 
                    Split(xlRList, "|")(i), vbYesNoCancel) 
                    If Rslt = vbCancel Then Exit Sub 
                    If Rslt = vbYes Then .Text = Split(xlRList, "|")(i) 
                    .Collapse wdCollapseEnd 
                    .Find.Execute 
                Loop 
            End With 
        Next 
        Application.ScreenUpdating = True 
    End Sub 
     '
    Function IsFileLocked(strFileName As String) As Boolean 
        On Error Resume Next 
        Open strFileName For Binary Access Read Write Lock Read Write As #1 
        Close #1 
        IsFileLocked = Err.Number 
        Err.Clear 
    End Function 
    
    
    Formatting tags added by mark007
    The macro has its own browser that you simply point to the folder containing the documents to be processed. All Word documents in that folder will be processed. You will, of course, need to supply your own workbook name and, perhaps, part or all of its path.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  5. #5
    Hi Macropod

    Excellent script it works exactly as I require (well nearly)

    Can you tell me how to change the replaced text to bold.

    I needed it highlighting but have solved that by changing the following
    '.Replacement.ClearFormatting
    .Replacement.Highlight = True

    I have tried the following to change the font to Bold

    .Replacement.Font = Bold
    .Replacement.Font = BoldBi
    .Replacement.Style = Bold

    Clearly I am not hitting the mark and know this is very simple. Can you please help with this.

    Thanks

  6. #6
    Hi

    Managed to get this working.

    .Replacement.Font.Bold = True


    Regards

    Robert

  7. #7
    Quote Originally Posted by Robxk View Post
    Hi

    Managed to get this working.

    .Replacement.Font.Bold = True


    Regards

    Robert
    Hi.

    For some reason I can't get this to work?
    My code looks like this:

    With ActiveDocument.Range
    With .Find
    .ClearFormatting
    .Replacement.Font.Bold = True
    .MatchWholeWord = True
    .MatchCase = True
    .Wrap = wdFindStop
    .Text = Split(xlFList, "|")(i)
    .Execute
    'To automatically change the found text:
    '• comment-out/delete the previous line and the Do While Loop
    '• uncomment the next two lines
    '.Replacement.Text = Split(xlRList, "|")(i)
    '.Execute Replace:=wdReplaceAll
    End With

    I'm new to all this VBA coding so there is a big chance I have put the section the wrong place.

    Best Regards Rasmus.

  8. #8
    I changed the .execute to automatic replacement and now it works with bold replacement? Is there a simple explaination for this?

  9. #9
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,091
    Location
    I suggest you check what's in the document - there's nothing in the code to apply any particular formatting.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  10. #10
    Hello

    Its a brilliant effort and I need some alteration in Code.
    Some where if Half of the value found in code, it also replace part of the that.
    Can we replace if Whole caption of cell (Ms Excel) is matched with whole caption of (Table)cell in ms Word? Can anybody help here?
    Thanks

  11. #11
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,091
    Location
    Khanonline: I have no idea what you're on about, re: "Half of the value found in code" or "Whole caption of cell". Also, instead of resurrecting old threads for what is evidently a new issue, you should start your own thread - explaining precisely what you want to achieve.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  12. #12
    It was a bit urgent to solve the issue. Although it didn't resolved yet. Anyways Thanks for reply.

    Paul: One thing I would like to quote here; the reason behind the resurrecting is my issue is same as this was but In word File it replaces the half data of the cell if matched in excel;
    what I required was if value of whole cell of Table (in Word File) is matched then it should replace the excel value and if half or any portion of cell in Table matched then it should left the cell as it is.

    Although it is challenge for me and indirectly was for you guys as well.

    Thanks for your patience and apologies for inconvenience.

  13. #13
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,091
    Location
    You could change:
    .Execute 
     'To automatically change the found text:
     ' comment-out/delete the previous line and the Do While Loop
     ' uncomment the next two lines
     '.Replacement.Text = Split(xlRList, "|")(i)
     '.Execute Replace:=wdReplaceAll
    End With 
     'Ask the user whether to change the found text
    Do While .Find.Found 
        .Duplicate.Select 
        Rslt = MsgBox("Replace this instance of:" & vbCr & _ 
        Split(xlFList, "|")(i) & vbCr & "with:" & vbCr & _ 
        Split(xlRList, "|")(i), vbYesNoCancel) 
        If Rslt = vbCancel Then Exit Sub 
        If Rslt = vbYes Then .Text = Split(xlRList, "|")(i) 
        .Collapse wdCollapseEnd 
        .Find.Execute 
    Loop 
    
    
    Formatting tags added by mark007
    to:
    .Execute 
    End With 
    Do While .Find.Found 
        With .Duplicate 
            If .Information(wdWithInTable) = True Then 
                If Len(.Cells(1).Range.Text) = Len(Split(xlRList, "|")(i)) + 2 Then 
                    .Text = Split(xlRList, "|")(i) 
                End If 
            End If 
        End With 
        .Collapse wdCollapseEnd 
        .Find.Execute 
    Loop 
    
    
    Formatting tags added by mark007
    For future reference, please start a new thread when starting a new topic, with links to any existing threads you think may be relevant.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  14. #14
    Dear user Macropod / Paul,

    I just wanted to say thanks for this extremely helpful bit of VBA code - I' m using it to insert ressource identifiers to scientific manuscripts, a rather repetitive task that is a lot faster (and less boring) with your macro.

    Are there any legal /copyright restrictions in sharing this code? I think others in the field might like it too. Who should it be credited to (Paul Edstein/ Macropod?).

    Cheers,

    Hans Zauner

  15. #15
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,091
    Location
    Code posted on these forums is free to use. If you're going to redistribute it, acknowledgement of the source would be appreciated (e.g. a comment in the code linking to where you found it). Regardless, you should avoid giving the impression it's your own code.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  16. #16
    Hi,

    99% of the time I find answers to all my code questions by reading through many forums, hence the reason I've never posted here before. However, this time, I'm pretty well stumped. I know enough (with a little help from google) to follow macropod's code above (and I will agree it is genius) however, I don't know enough to accurately fit it to my application. My goal is to simply have several text replacements in an existing word document template, using an existing worksheet. I have a range of text in column (A) I would like to have replaced with text in column (B). I am able to open both documents and change the first text replacement, but then it stops. Now I believe determined I need to write a For Loop to get this accomplished (just like in macropod's code above) difference is my data does not vary in array size. It will always be (A1:A8) to be replaced by (B1:B8). Any help is greatly appreciated. Below is where I'm at right now.
    Dim oWord As Word.Application    Dim RngF As String 
    Dim RngR As String 
     
    RngF = Range("A1:A8") 
    RngR = Range("B1:B8") 
     
    Application.ScreenUpdating = False 
     
     
     'Set application
    Set oWord = CreateObject("Word.Application") 
     
    oWord.Documents.Open (C:\\Path\Document.docx") 
     
    oWord.Visible = True 
     
     'Loop through find and replace
    For i = 1 To (RngF) 
        With ActiveDocument.Range 
            With .Find 
                .ClearFormatting 
                .Replacement.ClearFormatting 
                .MatchWholeWord = True 
                .MatchCase = True 
                .Wrap = wdFindContinue 
                .Text = (RngS) (i) 
                .Replacement.Text = (RngR) (i) 
                .Execute Replace:=wdReplaceAll 
            End With 
        End With 
    Next 
     
    Application.ScreenUpdating = True 
    
    
    Formatting tags added by mark007
    Last edited by CRay; 08-11-2017 at 09:07 AM.

  17. #17
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,091
    Location
    Try:
    Sub Demo() 
        Dim oWord As Word.Application, i As Long 
        Application.ScreenUpdating = False 
        Set oWord = CreateObject("Word.Application") 
        With oWord 
            .Documents.Open ("C:\Path\Document.docx") 
            With .ActiveDocument.Range.Find 
                .ClearFormatting 
                .Replacement.ClearFormatting 
                .MatchWholeWord = True 
                .MatchCase = True 
                .Wrap = wdFindContinue 
                For i = 1 To 8 
                    .Text = ActiveSheet.Range("A" & i) 
                    .Replacement.Text = ActiveSheet.Range("B" & i) 
                    .Execute Replace:=wdReplaceAll 
                Next 
            End With 
            .Visible = True 
        End With 
        Application.ScreenUpdating = True 
    End Sub 
    
    
    Formatting tags added by mark007
    Cheers
    Paul Edstein
    [MS MVP - Word]

  18. #18
    Quote Originally Posted by macropod View Post
    The following Word macro allows you to use an Excel Workbook to hold Find/Replace strings as the source for a large-scale Find/Replace operation. In this example, the macro finds the strings referred to in column A and replaces them with the strings referred to in column B. The user has the option to skip particular found strings, or to cancel the process altogether. Comments in the code show how to make the processing automatic (ie no user intervention). The bulk of the code (around 80%) is for managing the Excel session.
    Sub BulkFindReplace() 
        Application.ScreenUpdating = True 
        Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String 
        Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean 
        Dim xlFList As String, xlRList As String, i As Long, Rslt 
        StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\Workbook Name.xls" 
        StrWkSht = "Sheet1" 
        If Dir(StrWkBkNm) = "" Then 
            MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation 
            Exit Sub 
        End If 
         ' Test whether Excel is already running.
        On Error Resume Next 
        bStrt = False ' Flag to record if we start Excel, so we can close it later.
        Set xlApp = GetObject(, "Excel.Application") 
         'Start Excel if it isn't running
        If xlApp Is Nothing Then 
            Set xlApp = CreateObject("Excel.Application") 
            If xlApp Is Nothing Then 
                MsgBox "Can't start Excel.", vbExclamation 
                Exit Sub 
            End If 
             ' Record that we've started Excel.
            bStrt = True 
        End If 
        On Error GoTo 0 
         'Check if the workbook is open.
        bFound = False 
        With xlApp 
             'Hide our Excel session
            If bStrt = True Then .Visible = False 
            For Each xlWkBk In .Workbooks 
                If xlWkBk.FullName = StrWkBkNm Then ' It's open
                    Set xlWkBk = xlWkBk 
                    bFound = True 
                    Exit For 
                End If 
            Next 
             ' If not open by the current user.
            If bFound = False Then 
                 ' Check if another user has it open.
                If IsFileLocked(StrWkBkNm) = True Then 
                     ' Report and exit if true
                    MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use" 
                    If bStrt = True Then .Quit 
                    Exit Sub 
                End If 
                 ' The file is available, so open it.
                Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm) 
                If xlWkBk Is Nothing Then 
                    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation 
                    If bStrt = True Then .Quit 
                    Exit Sub 
                End If 
            End If 
             ' Process the workbook.
            With xlWkBk.Worksheets(StrWkSht) 
                 ' Find the last-used row in column A.
                 ' Add 1 to get the next row for data-entry.
                iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
                 ' Output the captured data.
                For i = 1 To iDataRow 
                     ' Skip over empty fields to preserve the underlying cell contents.
                    If Trim(.Range("A" & i)) <> vbNullString Then 
                        xlFList = xlFList & "|" & Trim(.Range("A" & i)) 
                        xlRList = xlRList & "|" & Trim(.Range("B" & i)) 
                    End If 
                Next 
            End With 
            If bFound = False Then xlWkBk.Close False 
            If bStrt = True Then .Quit 
        End With 
         ' Release Excel object memory
        Set xlWkBk = Nothing: Set xlApp = Nothing 
         'Process each word from the F/R List
        For i = 1 To UBound(Split(xlFList, "|")) 
            With ActiveDocument.Range 
                With .Find 
                    .ClearFormatting 
                    .Replacement.ClearFormatting 
                    .MatchWholeWord = True 
                    .MatchCase = True 
                    .Wrap = wdFindStop 
                    .Text = Split(xlFList, "|")(i) 
                    .Execute 
                     'To automatically change the found text:
                     ' comment-out/delete the previous line and the Do While Loop
                     ' uncomment the next two lines
                     '.Replacement.Text = Split(xlRList, "|")(i)
                     '.Execute Replace:=wdReplaceAll
                End With 
                 'Ask the user whether to change the found text
                Do While .Find.Found 
                    .Duplicate.Select 
                    Rslt = MsgBox("Replace this instance of:" & vbCr & _ 
                    Split(xlFList, "|")(i) & vbCr & "with:" & vbCr & _ 
                    Split(xlRList, "|")(i), vbYesNoCancel) 
                    If Rslt = vbCancel Then Exit Sub 
                    If Rslt = vbYes Then .Text = Split(xlRList, "|")(i) 
                    .Collapse wdCollapseEnd 
                    .Find.Execute 
                Loop 
            End With 
        Next 
        Application.ScreenUpdating = True 
    End Sub 
     '
    Function IsFileLocked(strFileName As String) As Boolean 
        On Error Resume Next 
        Open strFileName For Binary Access Read Write Lock Read Write As #1 
        Close #1 
        IsFileLocked = Err.Number 
        Err.Clear 
    End Function 
    
    
    Formatting tags added by mark007
    The macro has its own browser that you simply point to the folder containing the documents to be processed. All Word documents in that folder will be processed. You will, of course, need to supply your own workbook name and, perhaps, part or all of its path.

    Hi Macropod:

    Firstly, thank you very much for your code here - and for commenting it so well, and writing it with such clear syntax.

    I was wondering if you could point out for me where in the code the folder selection/browser is written? I cannot see where you select the folder which contains word docs to be processed. I feel like I must be missing something obvious, but I can't seem to find that?

    Thanks for your help!

    Tyler

  19. #19
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,091
    Location
    The comment in the post about a folder browser was wrong - there isn't one, since only the activedocument is being processed. That's what happens sometimes when boilerplate code is copied without checking the accompanying comments. The code for defining the Excel workbook is:
    StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\Workbook Name.xls"
    Cheers
    Paul Edstein
    [MS MVP - Word]

  20. #20

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •