Macro to pick information from notepad

[shekhu]

Hi All,

The following macro has a SearchArray and a ReplaceArray, to find and replace words. I am looking forward to modify this macro that instead of using the above arrays, it uses two .txt files to find and replace (image attached). The .txt files will be placed in My Document folder (default folder), or at certain specific drive whatever works. The reason being that it is easy for the user to modify and add words into a notepad and not doing corrections in the macro code.

Sub TestMacro()
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("first name", "last name", "home following for", "over the time")
ReplaceArray = Array("First Name", "Last Name", "who I am following for", "over time")
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
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
End With
Next
End Sub

The first question is, is it possible? Secondly, will it be slow? As at certain times I need to put in a few hundred sets of words there, although there is no problem in running the macro in a present code.

Thanks, and looking forward for a help.

[gmaxey]

Before getting into the code needed to use "two" notepad .txt files have you considered using just one Word file with a two column table?

[macropod]

For an example of reading in a Find/Replace list from another Word document, see my code at: http://www.vbaexpress.com/forum/showthread.php?t=34992 (http://www.vbaexpress.com/forum/showthread.php?t=34992)

The process for reading data from a plain text file is much the same.

[shekhu]

Greg and Paul, thanks for suggesting an option, it sounds great, but I am getting an error in that (image attached).

I am sorry, I still believe having a notepad would be better as to the speed.
Can we use a single-notepad having entries as below:
"first name" change to "^tFirst Name"
"last name" change to "Last Name^p"
"home following for" change to "who I am following for"
"over the time" change to "over time"

One of my friend suggested me a macro, but I could not run it as well.
Public myRefPath As String
Public i As Long
Public pFind, pReplace As String
Public sFileName, rFileName As String

Sub CallListForm()
'text files' location
myRefPath = Dialogs(wdDialogToolsOptionsFileLocations).setting
If Not Right$(myRefPath, 1) = "\" Then myRefPath = myRefPath & "\"

'text files' full name
sFileName = myRefPath & "lstSearch.txt"
rFileName = myRefPath & "lstReplace.txt"

'clears the two list boxes in the refForm form
With RefForm
.lbSearch.Clear
.lbReplace.Clear
End With

Dim lFile As Long
Dim sLine As String

lFile = FreeFile()

'registers all search words into search list box
Open sFileName For Input As lFile

While Not EOF(lFile)
Line Input #lFile, sLine
RefForm.lbSearch.AddItem sLine
Wend

Close lFile

'registers all replacement words into replacement list box
Open rFileName For Input As lFile

While Not EOF(lFile)
Line Input #lFile, sLine
RefForm.lbReplace.AddItem sLine
Wend

Close lFile

RefForm.Show
End Sub

Sub CheckMatch()
'text files' location
myRefPath = Dialogs(wdDialogToolsOptionsFileLocations).setting
If Not Right$(myRefPath, 1) = "\" Then myRefPath = myRefPath & "\"

'text files' full name
sFileName = myRefPath & "lstSearch.txt"
rFileName = myRefPath & "lstReplace.txt"

'clears the two list boxes in the refForm form
With RefForm
.lbSearch.Clear
.lbReplace.Clear
End With

Dim lFile As Long
Dim sLine As String

lFile = FreeFile()

'registers all search words into search list box
Open sFileName For Input As lFile

While Not EOF(lFile)
Line Input #lFile, sLine
RefForm.lbSearch.AddItem sLine
Wend

Close lFile

'registers all replacement words into replacement list box
Open rFileName For Input As lFile

While Not EOF(lFile)
Line Input #lFile, sLine
RefForm.lbReplace.AddItem sLine
Wend

Close lFile

'checks if both list boxes have the same amount of words stored
If RefForm.lbSearch.ListCount <> RefForm.lbReplace.ListCount Then MsgBox "Data doesn't match"

'replaces all the words based on the search list and highlights them
Options.DefaultHighlightColorIndex = wdYellow
For i = 0 To RefForm.lbSearch.ListCount - 1
Selection.HomeKey unit:=wdStory
pFind = RefForm.lbSearch.List(i)
pReplace = RefForm.lbReplace.List(i)
With Selection.Find
.Text = pFind
.Forward = True
.Replacement.Highlight = True

'checks if the word has a ":" to make the replacement bold
'if not, it simply replaces it normally
If Right$(pReplace, 1) = ":" Then
.Replacement.Text = "^p" & pReplace
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceOne
Else
.Replacement.Text = pReplace
.Replacement.Font.Bold = False
.Execute Replace:=wdReplaceAll
End If

End With
Next i
End Sub

[macropod]

Hi sheku,

Somehow I suspect your filepath is not the same as the one called by the macro. Check the FilePath variable! It tells Word where to find the document containing the Find text. I would have thought it obvious that you need to adapt the code to your circumstances ...

As for your comment about Notepad being better for speed, I doubt that opening two Notepad files to read the Find text and Replace text would be more efficient than opening a single Word file (which can hold both in either a table or as delimited (eg tab, comma, etc) strings in the same paragraph). Having the Find text and Replace text together in the same file also makes it easier to keep both sets of data synchronised.

[shekhu]

As I mentioned earlier

Can we use a single-notepad having entries as below:
"first name" change to "^tFirst Name"
"last name" change to "Last Name^p"
"home following for" change to "who I am following for"
"over the time" change to "over time"

Instead of single doc, if a single notepad (.txt) will do it would be great for me. Actually I intend to make things simple and work better. Also, the document wherein I want corrections to be made is opened from the network, and every time the path is different. It would be better, if the macro runs on an active document. Please refer to the code I posted on page #1.

As to the code you had suggested, there is no D: in my PC, so I have changed the path to drive E, and it also asks a path with a popup for the document to be processed. I would like that to be active document. Anyways, I could not get the required results. Please understand, I am not comfortable with this code.

As always, I thank you guys for the efforts you put in here.

[macropod]

Hi sheku,

Try the following. Modify the "Drive:\FilePath\FindReplaceList.doc" string to point to your source document holding the Find/Replace list.

Sub BulkFindReplace()
Application.ScreenUpdating = False
Dim FRDoc As Document, FRList As String, j As Long
'Load the strings from the reference doc into a text string to be used as an array.
Set FRDoc = Documents.Open("Drive:\FilePath\FindReplaceList.doc")
FRList = FRDoc.Range.Text
FRDoc.Close False
Set FRDoc = Nothing
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
'Process each word from the Check List. Tab-delimited strings are assumed, formatted as:
'Find text <Tab> Replace text
For j = 0 To UBound(Split(FRList, vbCr)) - 1
.Text = Split(Split(FRList, vbCr)(j), vbTab)(0)
.Replacement.Text = Split(Split(FRList, vbCr)(j), vbTab)(1)
.Execute Replace:=wdReplaceAll
Next
End With
Application.ScreenUpdating = True
End Sub

[shekhu]

Thanks Paul, this is what I was looking for. :yes

[shekhu]

Hello Paul, could you please modify the following macro on the above pattern. This is the macro that you had suggested some time earlier.

Sub TestSecondMacro()
Dim oRng As Range, fRng As Range, i As Integer
Dim Msg As String
Dim SearchArray As Variant, ReplaceArray As Variant
SearchArray = Array("first name", "last name", "home following for", "over the time")
ReplaceArray = Array("First Name", "Last Name", "who I am following for", "over time")
With Selection
Set oRng = .Range
With .Find
.ClearFormatting
.MatchCase = True
.Highlight = False
.MatchWildcards = False
.Wrap = wdFindContinue
.Forward = True
For i = 0 To UBound(SearchArray)
.Text = SearchArray(i)
Do While .Execute = True
If Selection.Start > oRng.End Then Exit Do
Set fRng = ActiveDocument.Range(Start:=Selection.Start, End:=Selection.End)
With fRng
Msg = "ChangeThis=> " & SearchArray(i) & vbCr _
& "With?=> " & ReplaceArray(i)
If MsgBox(Msg, vbYesNo, "Change Format") = vbYes Then
.Text = ReplaceArray(i)
.HighlightColorIndex = wdBrightGreen
.Collapse Direction:=wdCollapseEnd
End If
End With
Loop
oRng.Select
Next
End With
End With
oRng.Select
Set fRng = Nothing: Set oRng = Nothing
End Sub

[macropod]

Hi Sunil,

Perhaps you could explain what you're trying to achieve. There are various possible interpretations of:

modify the following macro on the above pattern
The 'BulkFindReplace' macro processes the whole document, whilst the 'TestSecondMacro' macro only processes a selected range (unless nothing is selected).

The 'BulkFindReplace' macro replaces all found array entries without asking and without changing the formatting, whilst the 'TestSecondMacro' macro asks before processing a given array entry and, if affirmed, changes the formatting also.

So, what do you want to do and what have you tried?

[shekhu]

Paul, this macro replaces only with message popping up and with selection. I would like everything the same except the "Search and Replace Array" changed to reference document. I tried with the code but all in vain. Looking forward for your suggestion.

[macropod]

Hi Sunil,

Making those changes is fairly easy. I'm surprised you couldn't figure it out. All the necessary code exists in the two macros. The only significant change I made when combining the subs was to introduce two new variables (StrFnd As String, StrRep As String) and even these aren't really necessary:

Sub Demo()
Application.ScreenUpdating = False
Dim FRList As String, Msg As String, StrFnd As String, StrRep As String
Dim FRDoc As Document, oRng As Range, fRng As Range, i As Long
'Load the strings from the reference doc into a text string to be used as an array.
Set FRDoc = Documents.Open("Drive:\FilePath\FindReplaceList.doc")
FRList = FRDoc.Range.Text
FRDoc.Close False
Set FRDoc = Nothing
With Selection
Set oRng = .Range
With .Find
.ClearFormatting
.MatchCase = True
.Highlight = False
.MatchWildcards = False
.Wrap = wdFindContinue
.Forward = True
For i = 0 To UBound(Split(FRList, vbCr)) - 1
StrFnd = Split(Split(FRList, vbCr)(i), vbTab)(0)
StrRep = Split(Split(FRList, vbCr)(i), vbTab)(1)
Msg = "ChangeThis=> " & StrFnd & vbCr & "With?=> " & StrRep
.Text = StrFnd
Do While .Execute = True
If Selection.Start > oRng.End Then Exit Do
Set fRng = ActiveDocument.Range(Start:=Selection.Start, End:=Selection.End)
With fRng
If MsgBox(Msg, vbYesNo, "Change Format") = vbYes Then
.Text = StrRep
.HighlightColorIndex = wdBrightGreen
.Collapse Direction:=wdCollapseEnd
End If
End With
Loop
oRng.Select
Next
End With
End With
oRng.Select
Set fRng = Nothing: Set oRng = Nothing
End Sub

[shekhu]

SOLVED: Thanks Paul, this is great and seems perfect now. :bow: