Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 22

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
    4,435
    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
    [Fmr 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
    4,435
    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
    You will, of course, need to supply your own workbook name and, perhaps, part or all of its path.
    Last edited by macropod; 08-07-2018 at 08:04 PM.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #5
    VBAX Newbie
    Joined
    Jan 2013
    Posts
    3
    Location
    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
    VBAX Newbie
    Joined
    Jan 2013
    Posts
    3
    Location
    Hi

    Managed to get this working.

    .Replacement.Font.Bold = True


    Regards

    Robert

  7. #7
    VBAX Newbie
    Joined
    Nov 2014
    Posts
    4
    Location
    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.
    Last edited by SamT; 11-26-2017 at 02:49 PM.

  8. #8
    VBAX Newbie
    Joined
    Nov 2014
    Posts
    4
    Location
    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
    4,435
    Location
    I suggest you check what's in the document - there's nothing in the code to apply any particular formatting.
    Cheers
    Paul Edstein
    [Fmr 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
    4,435
    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
    [Fmr 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
    4,435
    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
    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
    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
    [Fmr MS MVP - Word]

  14. #14
    VBAX Newbie
    Joined
    Aug 2017
    Posts
    1
    Location
    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
    4,435
    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
    [Fmr MS MVP - Word]

  16. #16
    VBAX Newbie
    Joined
    Aug 2017
    Posts
    1
    Location
    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
    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
    4,435
    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
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  18. #18
    Hi Macropod:

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

    Thanks for your help!

    Tyler
    Last edited by macropod; 08-07-2018 at 08:09 PM. Reason: Deleted unnecessary quote of entire post replied to

  19. #19
    VBAX Newbie
    Joined
    Oct 2017
    Posts
    1
    Location
    Thanks Marcopod!

  20. #20
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Paul,

    This thread has been reopened every year for six years. Think we should Sticky it?
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

Posting Permissions

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