Replacement text to text and field in word with vba - vba

Question

I have a working, however a slow method for searching through a document and search for a specific text: Issue "tab" A and then replace it with text but where A is referred to a customvariable. Has anyone done something similar?
Sub hsdkjgh()
Call replaceIssueNonVariable(ActiveDocument)
End Sub
Public Function SearchInStory(ByVal rngStory As word.Range, ByVal strSearch As String) As Boolean
SearchInStory = False
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Wrap = wdFindContinue
.MatchCase = False
.MatchWildcards = True
.Execute
If .found Then
rngStory.Text = "Issue:" & vbTab & ";;;;;;"
Call SearchInStory2(rngStory, ";;;;;;")
SearchInStory = True
End If
End With
End Function
Public Function SearchInStory2(ByVal rngStory As word.Range, ByVal strSearch As String) As Boolean
SearchInStory2 = False
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Wrap = wdFindContinue
.MatchCase = False
.MatchWildcards = True
.Execute
If .found Then
rngStory.Select
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDocProperty, Text:="_DocumentIssue", PreserveFormatting:=True
SearchInStory2 = True
End If
End With
End Function
Sub replaceIssueNonVariable(doc As Document)
Dim temp As Variant
Dim pFindTxtArray(4) As String
Dim pReplaceTxtArray(4) As String
pReplaceTxt = "Issue:^t" ' { DOCPROPERTY _DocumentIssue ^92* MERGEFORMAT }"
ActiveWindow.View.ShowFieldCodes = True
exitRevision = False
For i = 65 To 90
pFindTxt = "Issue:^t^" & i
'Iterate through all story types in the current document
For Each rngStory In doc.StoryRanges
'Iterate through all linked stories
Do
If SearchInStory(rngStory, pFindTxt) Then
'rngStory.Select
'Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDocProperty, Text:="_DocumentIssue", PreserveFormatting:=True
exitRevision = True
End If
On Error Resume Next
Select Case rngStory.StoryType
Case WdStoryType.wdEvenPagesHeaderStory, _
WdStoryType.wdPrimaryHeaderStory, _
WdStoryType.wdEvenPagesFooterStory, _
WdStoryType.wdPrimaryFooterStory, _
WdStoryType.wdFirstPageHeaderStory, _
WdStoryType.wdFirstPageFooterStory
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If oShp.TextFrame.HasText Then
If SearchInStory(rngStory, pFindTxt) Then
exitRevision = True
End If
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
If exitRevision Then
Call CustomProperties.createCustomDocumentProperty(doc, "_DocumentIssue", Chr(i))
Exit For
End If
Next i
' Refresh fields
doc.Fields.update
ActiveWindow.View.ShowFieldCodes = False
Exit Sub
'create the new variable
Call CustomProperties.createCustomDocumentProperty(doc, "_DocumentIssue", Right(pFindTxtArray, 1))
doesNotExist:
MsgBox "CustomVariable " & findText & " does not exist"
Exit Sub
Debug.Print findText & " variable has got this new name: " & replaceText
End Sub