Find and replace fields in Word using VBA

The following code finds a field in a document (highlighted), deletes it and replaces it with two new fields.

It seems to work as required, perhaps not as elegantly written as it could be, but it does the job.

Code:

---

Sub ReplaceFieldsV2()

    Application.ScreenUpdating = False
    ActiveWindow.View.ShowFieldCodes = True
    With Selection
        .HomeKey Unit:=wdStory
        .Find.ClearFormatting
        With Selection.Find
            .Text = "^d SEQ Table \* ARABIC"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        .Find.Execute
        .Delete Unit:=wdCharacter, Count:=1
        .TypeText Text:=" "
   
        .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
            "StyleRef " & """GA Numbered Heading 1""" & " \s", PreserveFormatting:=False
        .TypeText Text:="-"
        Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
            "SEQ " & """Table""" & " \* ARABIC \r 1", PreserveFormatting:=False
    End With
    ActiveWindow.View.ShowFieldCodes = False
    Call SpecialUpdateFields
    Application.ScreenUpdating = True
   
End Sub

---

This procedure just deals with the first field it comes to. What I want to do is for it to move on to the next field, replace it and then so on for all the other similar fields until no more are found.

I tried researching a For...Loop or a While...Wend but couldn't fathom out where and how to use these. And which would be the best one to employ in this case.

Could someone point me in the right direction, please?

Thanks

Roderick

I think I would be inclined to loop trough the seq fields themselves e.g. as follows, which should work if the fields are in the body of the document.

Code:

---

Sub ReplaceFieldsV3()
'Graham Mayor - http://www.gmayor.com - Last updated - 24 Sep 2018
Dim oFld As Field, oNewFld As Field
Dim oRng As Range, oSeq As Range
    For Each oFld In ActiveDocument.Fields
        If oFld.Type = wdFieldSequence Then
            If InStr(1, oFld.Code, "Table") > 0 Then
                oFld.Code.Text = Replace(oFld.Code.Text, oFld.Code.Text, "SEQ Table \* ARABIC \r 1")
                oFld.Update
                Set oRng = oFld.Code
                oRng.MoveEnd wdCharacter, 1
                oRng.Collapse 0
                Set oNewFld = ActiveDocument.Fields.Add(Range:=oRng, _
                                                        Type:=wdFieldStyleRef, _
                                                        Text:="""GA Numbered Heading 1""" & " \s", _
                                                        PreserveFormatting:=False)
                oNewFld.Update
            End If
        End If
    Next oFld
    ActiveWindow.View.ShowFieldCodes = False
lbl_Exit:
    Set oFld = Nothing
    Set oNewFld = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

---

Thanks very much Graham for the great Heads Up and it works as you planned.

However, the new added wdStyleRef field has to go before the SEQ field and both fields have to be separated by a single dash character. At the moment, the new field goes after the SEQ and there is no gap between these to allow for a hyphen.

I've tried using using .MoveStart where it says .MoveEnd but this is of course just a character. It has to move (collapse) before the field SEQ then followed by a space.

You may be asking why this is all necessary? Well, these fields are for creating Table Chapter Headings using special styles and not those imposed by Microsoft (Heading 1, etc). Hence the GA Numbered Heading 1 you see in the code. The end result of course will be (chapter) 1-(item) 1 and so on.

Is it possible to achieve this structure, please?

Roderick

OK. It's just a question of relocating the ranges e.g.

Code:

---

Sub ReplaceFieldsV4()
'Graham Mayor - http://www.gmayor.com - Last updated - 25 Sep 2018
Dim oFld As Field, oNewFld As Field
Dim oRng As Range, oSeq As Range
    For Each oFld In ActiveDocument.Fields
        If oFld.Type = wdFieldSequence Then
            If InStr(1, oFld.Code, "Table") > 0 Then
                oFld.Code.Text = Replace(oFld.Code.Text, oFld.Code.Text, "SEQ Table \* ARABIC \r 1")
                oFld.Update
                Set oRng = oFld.Code
                oRng.MoveStart wdCharacter, -1
                oRng.Collapse 1
                oRng.Text = "-"
                oRng.Collapse 1
                Set oNewFld = ActiveDocument.Fields.Add(Range:=oRng, _
                                                        Type:=wdFieldStyleRef, _
                                                        Text:="""GA Numbered Heading 1""" & " \s", _
                                                        PreserveFormatting:=False)
                oNewFld.Update
            End If
        End If
    Next oFld
    ActiveWindow.View.ShowFieldCodes = False
lbl_Exit:
    Set oFld = Nothing
    Set oNewFld = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

---