How to Get the String from a file

[Rakesh]

Hi Guys,


I have taken the below code from this site. It works fine. But I have a bunch of list to Replace. Inserting each string into the SearchArray and ReplaceArray consumes more time.

Is there is any other way to get the string and replace string from a file.

I have attached a file for your reference.

Sub RepAll()
Dim SearchArray As Variant
Dim ReplaceArray As Variant
Dim myRange As Range
Dim i As Long
Dim pFind As String
Dim pReplace As String
SearchArray = Array("abilify", "acetazolamide", "aciphex", "actonel", "actos")
ReplaceArray = Array("Abilify", "acetazolamide", "AcipHex", "Actonel", "Actos")
Set myRange = Selection.Range
For i = LBound(SearchArray) To UBound(SearchArray)
pFind = SearchArray(i)
pReplace = ReplaceArray(i)
With myRange.Find
.Text = pFind
.Replacement.Text = pReplace
.MatchWholeWord = True
.Execute Replace:=wdReplaceAll
.Replacement.Highlight = True
End With
Next
End Sub


Thanks
Rakesh

[gmaxey]

Yes. Considering you attached and Excel file I will assume that is the type of file you plan to use.

The following code should show you how to build a multi-dimensional array from an Excel file:

Option Explicit
Private ListArray As Variant
Sub ExcelList_Find_Replace_Anywhere()
Dim rngStory As Word.Range
Dim lngJunk As Long
Dim oShp As Shape
'Change the path to point to your two column Excel word list (Note first row in list (i.e., A1 and B1) contains captions "Find" and "Replace")
ListArray = GetListArray("D:\Data Stores\Find and Replace List.xlsx")
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
ResetFRParameters
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SrcAndRplInStory rngStory, ListArray
On Error Resume Next
Select Case rngStory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If oShp.TextFrame.HasText Then
SrcAndRplInStory oShp.TextFrame.TextRange, ListArray
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
End Sub
Public Sub SrcAndRplInStory(ByVal rngStory As Word.Range, _
ByRef ListArray As Variant)
Dim i As Long
For i = LBound(ListArray) + 1 To UBound(ListArray)
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ListArray(i, 1)
.Replacement.Text = ListArray(i, 2)
.Execute Replace:=wdReplaceAll
End With
Next i
End Sub
Sub ResetFRParameters()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub
Function GetListArray(ByRef pStr As String) As Variant
GetExcelarray:
Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim bstartApp As Boolean
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
bstartApp = True
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlbook = xlapp.Workbooks.Open(FileName:=pStr)
Set xlsheet = xlbook.Worksheets(1)
GetListArray = xlsheet.Range("A1").CurrentRegion.Value
xlbook.Close
If bstartApp = True Then
xlapp.Quit
End If
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
Exit Function
End Function

[Rakesh]

Hi gmaxey,

Thanks for your Kind reply. Its working Fine. But it take more than 20 minutes to complete the macro.

Is there is any way to Faster the macro?

Thanks
Rakesh

[gmaxey]

Use a smaller list of words?

Is "it" the procedure that I provided or a version of yours using the method that I provided to create the array of words?

If the former then if you are not concerned with multi-section documents, or terms in the headers, footers, or the (up to) 14 other document storyranges then process only the storyrange or storyranges that you are concerned with.

If the latter then I have no idea.