Replace specific word inside a table in the Header with Merge field

Turin74 · #1 06-06-2019, 07:23 AM

Hi,
I'm trying to replace hardcoded addresses in a table inside the header with mailmerge fields
e.g.
1 Spring Avenue
Springarea
Springtown
Springfield TT4 77S

With
{MERGEFIELD Address_line1}
{MERGEFIELD Address_line2}
{MERGEFIELD Address_line3}
{MERGEFIELD Address_line4} {MERGEFIELD Address_PostCode}

The same address appears elsewhere like in main area or footer but only the address in the header should be replaced

I have tried

Sub replace()

Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="Springtown")
oRng.Fields.Add oRng, wdFieldMergeField, "Address_line1", False
oRng.Collapse wdCollapseEnd
Loop
End With

End Sub

Sub replace2()

Dim oRng As Range
Dim hf As Word.HeaderFooter
Dim tableCount As Integer
Dim t As Integer
Dim c As Cell

Set oRng = ActiveDocument.Range
For Each hf In oRng.Sections(1).Headers()
tableCount = hf.Range.Tables.Count
For t = 1 To tableCount
For Each c In hf.Range.Tables(t).Range.Cells
Debug.Print c.Range.Text
With c.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Colchester"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
If .Find.Found = True Then
.Fields.Add .Range, wdFieldEmpty, "MERGEFIELD Address_line1", False
End If
Next c
Next t

Next hf

End Sub

Sub replace3()

Dim oRng As Range
Dim hf As Word.HeaderFooter
Dim tableCount As Integer
Dim t As Integer
Dim c As Cell

For Each hf In ActiveDocument.Sections(1).Headers
With hf.Range

With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Springtown"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
If .Find.Found = True Then
.Fields.Add .Range, wdFieldEmpty, "MERGEFIELD Address_line1", False
End If
End With
Next

End Sub

But i am not having much luck - any ideas
Thanks

gmaxey · #2 06-06-2019, 11:27 AM

Code:

Sub replace3()
Dim oRng As Range
Dim hf As Word.HeaderFooter
For Each hf In ActiveDocument.Sections(1).Headers
  Set oRng = hf.Range
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "Springtown"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    While .Execute
      hf.Range.Fields.Add oRng, wdFieldEmpty, "MERGEFIELD Address_line1", False
      oRng.Collapse wdCollapseEnd
    Wend
  End With
Next
End Sub

macropod · #3 06-06-2019, 04:42 PM

Perhaps as a single macro:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Sections.First.Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 3)
  Set Rng = .Range
  Rng.Text = vbNullString
  Rng.End = Rng.End - 1
  .Range.Fields.Add Rng, wdFieldEmpty, "MERGEFIELD Address_PostCode", False
  Rng.Characters.Last.InsertBefore " "
  .Range.Fields.Add Rng, wdFieldEmpty, "MERGEFIELD Address_line4", False
  Rng.Characters.Last.InsertBefore Chr(11)
  .Range.Fields.Add Rng, wdFieldEmpty, "MERGEFIELD Address_line3", False
  Rng.Characters.Last.InsertBefore Chr(11)
  .Range.Fields.Add Rng, wdFieldEmpty, "MERGEFIELD Address_line2", False
  Rng.Characters.Last.InsertBefore Chr(11)
  .Range.Fields.Add Rng, wdFieldEmpty, "MERGEFIELD Address_line1", False
End With
Application.ScreenUpdating = True
End Sub

As coded, the macro assumes the mergefields go in cell C1 of the table.

macropod · #4 06-06-2019, 06:17 PM

Cross-posted at: https://social.msdn.microsoft.com/Fo...?forum=worddev
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Update & Unlink Specific Merge Field in Word Doc from Mail Merge - Excel VBA	RMerckling	Mail Merge	16	05-17-2018 05:19 PM
VBA Table – Search All Tables - Find & Replace Text in Table Cell With Specific Background Color	jc491	Word VBA	8	09-30-2015 06:10 AM
Adding field in word in header in a bookmark in table with Excel vba Late Binding	Hdr	Excel Programming	6	02-11-2013 02:58 AM
Excel vba adding field in word table/shape in a header	Hdr	Excel	1	02-04-2013 04:40 PM
Merge field in header disappearing	Medievalguy88	Word	2	01-06-2011 08:19 AM