Finding matches from a list and replacing from another list, one by one (not global)

[Harry88]

I need to create a pair of macros, one to replace specified characters in font A with the corresponding characters in font B, and one to do the same thing the other way around.

-----------
MACRO #1 (FindSymbolReplaceNormal)


This macro should find a specified character in the Symbol font and replace it with the corresponding character in the normal font.


For example, the following code will find all occurrences of the degree symbol in the Symbol font and replace them with the degree symbol in the normal font.



Sub FindSymbolReplaceNormal()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(61616)
.Replacement.Text = "°"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
EndSub


-----------
MACRO #2 (FindNormalReplaceSymbol)


This macro should find a specified character in the normal font and replace it with the corresponding character in the Symbol font.


For example, the following code will find all occurrences of the degree symbol in the normal font and replace them with the degree symbol in the Symbol font.



Sub FindNormalReplaceSymbol()
Selection.Find.ClearFormatting
With Selection.Find
.Text = "°"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
End With
Selection.Find.Execute
Selection.InsertSymbol Font:="Symbol", CharacterNumber:=-3920, Unicode:=True
End Sub


-----------
Note that finding a character in the Symbol font and replacing it with the corresponding character in the normal font can be done with a direct find/replace function (as in Macro #1), but finding a character in the normal font and replacing it with the corresponding character in the Symbol font cannot be done with a direct find/replace function but needs to be done by first finding the character in the normal font and then using the InsertSymbol function to overwrite it (not simply replace it) with the required character (as in Macro #2).


I would like to make both macros work as follows.


- Each macro should run through a whole document (or a selected block of text) to find and replace all matches, but it should stop on each match and give the user the option of replacing or skipping each one individually, not globally.


- Each macro should specify a list of characters to find, and a corresponding list of characters to replace. The macro should loop through the "find" list and replace matches with the corresponding character from the "replace" list. For example, Macro 1 should find the degree symbol and the plus-or-minus symbol in the Symbol font -- i.e., ChrW(61616) and ChrW(61617) -- and replace them with the corresponding characters in the normal font -- i.e., "°" and "±" respectively; and Macro 2 should do the reverse, but using the InsertSymbol function to overwrite rather than simply replace.


Is this possible?

[gmayor]

The following will do that:

Sub Macro1()
Dim vFindText As Variant
Dim vReplaceText As Variant
Dim oRng As Range
Dim i As Integer
vFindText = Array(ChrW(61616), ChrW(61617))
vReplaceText = Array(Chr(176), Chr(177))
For i = 0 To UBound(vFindText)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = vFindText(i)
.Font.Name = "Symbol"
Do While .Execute
oRng.Text = vReplaceText(i)
oRng.Style = "Normal"
oRng.Collapse 0
Loop
End With
Next i
End Sub

Sub Macro2()
Dim vFindText As Variant
Dim vReplaceText As Variant
Dim oRng As Range
Dim i As Integer
vFindText = Array(Chr(176), Chr(177))
vReplaceText = Array(ChrW(61616), ChrW(61617))
For i = 0 To UBound(vFindText)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = vFindText(i)
.Font.Name = "Symbol"
Do While .Execute
oRng.Text = vReplaceText(i)
oRng.Style = "Normal"
oRng.Collapse 0
Loop
End With
Next i
End Sub
You can add any other symbols and their corresponding values into the arrays as required.

[Harry88]

Thanks for your reply. I tried those macros in the test document below, and they appeared to run OK, but nothing appeared to be changed.

30498

I note the two macros are identical except that the two lines defining the find and replace arrays are reversed.

- Macro #1 needs to change found characters from Symbol to normal font, but Macro #2 needs to change found characters from normal to Symbol font. Will this code do that?

- Both macros need to stop on each match and give the user the option of replacing or skipping each one individually, not globally. Will this code do that?

[Aussiebear]

How will you know in what section the find and replace would occur?

[Harry88]

I'm not sure I understand what you are asking. Each macro should find and replace all matches in a selected block of text (or the whole document if nothing is selected), but it should stop on each match and give the user the option of replacing or skipping each one individually, not globally.

[Aussiebear]

How would you know which one it has found and is asking if you want to replace it?

[Harry88]

In these examples, I envisage the macro would loop through the selection (or the whole document if nothing is selected) twice: on the first loop, it would search for the degree symbol and stop on each match with some kind of prompt (e.g., Replace? [Yes] [No]), then on the second loop it would search for the plus-or-minus symbol and stop on each match with the same prompt. Each time it stops on a match, the user can see the found character, highlighted in the usual way when the find function is used.

[Aussiebear]

Harry88, you are skipping over my question yet again. Posts 5 & 7 are descriptors of the intent of the macros, so we don't need to hear your broad definitions of them again for we understood that from Post#1. What I am trying to determine here is, once the macros find a ° Symbol or the - or - symbol, how do you determine where it is in the document, so that you can decide do I replace it or not? What logic do you intend to apply to come up with the decision to replace or not?

[Aussiebear]

Talking about Post #1. You mention a number of times the descriptor "replace" or "replacing" yet later on mention you want to overwrite rather than replace. What is your understanding of overwrite compared to replace?

[Harry88]

Sorry I misunderstood what you were asking.

Re the location of each match and deciding whether to replace or skip it: The decision is an editorial one. It depends on the context of the character; e.g., symbols within the text are usually replaced, but symbols within equation objects are usually skipped. The location within the document is not relevant. The replacement should not be done globally, hence the requirement to stop on each match so the user can replace or skip each one individually.

Re "replace" vs "overwrite": Fot Macro #1, which needs to replace characters in the Symbol font with ones in the normal font, a regular "replace" operation can be used; e.g., ChrW(61616) can be replaced with "°". For Macro #2, which needs to replace characters in the normal font with ones in the Symbol font, the output should be the same as the result of using the InsertSymbol function, and I don't know whether a regular "replace" operation can achieve this – e.g., simply replace "°" with ChrW(61616) – or whether the InsertSymbol function needs to be used. I have previously experienced compatibility issues with characters in the Symbol font that are not inserted in this way.

[gmayor]

The following should work and appears to do so with your sample


Sub Macro1()
Dim vFindText As Variant
Dim vReplaceText As Variant
Dim oRng As Range
Dim i As Integer
Dim lAsk As Long
vFindText = Array(ChrW(61616), ChrW(61617))
vReplaceText = Array(Chr(176), Chr(177))
For i = 0 To UBound(vFindText)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = vFindText(i)
Do While .Execute
oRng.Select
lAsk = MsgBox("Replace Symbol", vbYesNoCancel)
If lAsk = 2 Then GoTo lbl_Exit
If lAsk = 6 Then
oRng.Text = vReplaceText(i)
oRng.Font.Name = "Times New Roman"
End If
oRng.Collapse 0
Loop
End With
Next i
lbl_Exit:
Exit Sub
End Sub

Sub Macro2()
Dim vFindText As Variant
Dim vReplaceText As Variant
Dim oRng As Range
Dim i As Integer
Dim lAsk As Long

vFindText = Array(Chr(176), Chr(177))
vReplaceText = Array(ChrW(61616), ChrW(61617))
For i = 0 To UBound(vFindText)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = vFindText(i)
Do While .Execute
oRng.Select
lAsk = MsgBox("Replace Symbol", vbYesNoCancel)
If lAsk = 2 Then GoTo lbl_Exit
If lAsk = 6 Then
oRng.Text = vReplaceText(i)
oRng.Font.Name = "Symbol"
End If
oRng.Collapse 0
Loop
End With
Next i
lbl_Exit:
Exit Sub
End Sub

[Harry88]

Those macros run in the required way (finding matches and prompting the user to replace or skip), thank you.

However, they don't produce the required output exactly. There are two issues, a different one in each macro.

- With Macro #1 (replacing characters in the Symbol font with ones in the normal font), the font of the replacement characters should not be specified by the macro but should be simply the font of the surrounding text. Removing line 19 (oRng.Font.Name = "Times New Roman") appears to resolve this issue.

- With Macro #2 (replacing characters in the normal font with ones in the Symbol font), the replacement characters have the right look but also have compatibility issues, which these macros are intended to circumvent. It appears these characters must be produced using the InsertSymbol function. When they have been produced in this way, double-clicking on them opens the InsertSymbol dialog box; and when they are selected, the font field in the ribbon shows the font of the surrounding text, not "Symbol". When I recorded a macro in which I produced these characters in this way, the part of the code that produced the characters was as follows.


Selection.InsertSymbol Font:="Symbol", CharacterNumber:=-3920, Unicode:=True

(The character number is -3920 for the degree symbol, and -3919 for the plus-or-minus symbol.)

Is it possible to modify Macro #2 to use this method?

[Aussiebear]

Have you tried?

oRng.Font.Name = "Symbol", CharacterNumber:=-3920, Unicode:=True"

[Harry88]

Do you mean try replacing line 19 in Macro #2 ...


oRng.Font.Name = "Symbol"

... with this?


oRng.Font.Name = "Symbol", CharacterNumber:=-3920, Unicode:=True

When I tried that just now, it said "Compile error: Expected: end of statement" with the first comma highlighted.

If it did work, I think the character number would need to be replaced by a variable though, because the character number is different for each character (-3920 = degree, -3919 = plus-or-minus) and so would need to change for each iteration of the loop, but I don't know enough VBA to get it working.

[gmayor]

To fix the issue as suggested, change Macro2 to

Sub Macro2()
Dim vFindText As Variant
Dim vReplaceText As Variant
Dim oRng As Range
Dim i As Integer
Dim lAsk As Long

vFindText = Array(Chr(176), Chr(177))
vReplaceText = Array(-3920, -3919)
For i = 0 To UBound(vFindText)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = vFindText(i)
Do While .Execute
oRng.Select
lAsk = MsgBox("Replace Symbol", vbYesNoCancel)
If lAsk = 2 Then GoTo lbl_Exit
If lAsk = 6 Then
oRng.InsertSymbol Font:="Symbol", _
CharacterNumber:=vReplaceText(i), _
Unicode:=True
End If
oRng.Collapse 0
Loop
End With
Next i
lbl_Exit:
Exit Sub
End Sub

[Harry88]

That works fine, thanks.

Is it possible to modify this further so it will only find characters from a specific font?

Is it also possible to add a message if no matches are found?

[gmayor]

If there are no matches, you won't get the prompt to change it. However:


Sub Macro2()
Dim vFindText As Variant
Dim vReplaceText As Variant
Dim oRng As Range
Dim i As Integer, j As Integer, k As Integer, m As Integer
Dim lAsk As Long
Const strFontName As String = "Times New Roman" 'The font to search

vFindText = Array(Chr(176), Chr(177))
vReplaceText = Array(-3920, -3919)
j = 0: k = 0: m = 0
For i = 0 To UBound(vFindText)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = vFindText(i)
.Font.Name = strFontName
Do While .Execute
j = j + 1
oRng.Select
lAsk = MsgBox("Replace Symbol", vbYesNoCancel)
If lAsk = 2 Then GoTo lbl_Exit
If lAsk = 6 Then
k = k + 1
oRng.InsertSymbol Font:="Symbol", _
CharacterNumber:=vReplaceText(i), _
Unicode:=True
Else
m = m + 1
End If
oRng.Collapse 0
Loop
End With
Next i
lbl_Exit:
If j = 0 Then MsgBox "There are no matches", vbInformation
If k > 0 Or m > 0 Then MsgBox k & " substitutions made" & vbCr & _
m & " substitutions skipped", vbInformation
Exit Sub
End Sub

[Harry88]

That works fine, thanks again.

I have now made a Macro #3 based on Macro #2, with a different set of characters to find and replace (the first four letters of the Greek alphabet).


Sub Macro3()
Dim vFindText As Variant
Dim vReplaceText As Variant
Dim oRng As Range
Dim i As Integer, j As Integer, k As Integer, m As Integer
Dim lAsk As Long
Const strFontName As String = "Symbol" 'The font to search


vFindText = Array(ChrW(61537), ChrW(61538), ChrW(61543), ChrW(61540))
vReplaceText = Array(-3999, -3998, -3993, -3996)
j = 0: k = 0: m = 0
For i = 0 To UBound(vFindText)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = vFindText(i)
.Font.Name = strFontName
Do While .Execute
j = j + 1
oRng.Select
lAsk = MsgBox("Replace Symbol", vbYesNoCancel)
If lAsk = 2 Then GoTo lbl_Exit
If lAsk = 6 Then
k = k + 1
oRng.InsertSymbol Font:="Symbol", _
CharacterNumber:=vReplaceText(i), _
Unicode:=True
Else
m = m + 1
End If
oRng.Collapse 0
Loop
End With
Next i
lbl_Exit:
If j = 0 Then MsgBox "There are no matches", vbInformation
If k > 0 Or m > 0 Then MsgBox k & " substitutions made" & vbCr & _
m & " substitutions skipped", vbInformation
Exit Sub
End Sub

This version should:
- (1) find each of the specified characters in the Find array, then
- (2) remove the Symbol font formatting from each match, then
- (3) replace the match from the replace array (the same characters but using the InsertSymbol function).

It has the code needed for steps (1) and (3), but how can step (2) be added (i.e., remove the Symbol font formatting from each match before it is replaced)? If possible, it should remove just the Symbol font formatting but retain any character formatting such as bold, italic, underline.

A test document is attached.
30514

[gmayor]

I think the following is what you require:

Option Explicit

Sub Macro3()
Dim vFindText As Variant
Dim vReplaceText As Variant
Dim oRng As Range
Dim i As Integer, j As Integer, k As Integer, m As Integer
Dim lAsk As Long
Const strFontName As String = "Symbol" 'The font to search
Dim strFontReplace As String

vFindText = Array(ChrW(61537), ChrW(61538), ChrW(61543), ChrW(61540))
vReplaceText = Array(-3999, -3998, -3993, -3996)
j = 0: k = 0: m = 0
For i = 0 To UBound(vFindText)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = vFindText(i)
.Font.Name = strFontName
Do While .Execute
j = j + 1
strFontReplace = oRng.Next.Font.Name
oRng.Select
lAsk = MsgBox("Replace Symbol", vbYesNoCancel)
If lAsk = 2 Then GoTo lbl_Exit
If lAsk = 6 Then
k = k + 1
oRng.Font.Name = strFontReplace
oRng.InsertSymbol Font:="Symbol", _
CharacterNumber:=vReplaceText(i), _
Unicode:=True
Else
m = m + 1
End If
oRng.Collapse 0
Loop
End With
Next i
lbl_Exit:
If j = 0 Then MsgBox "There are no matches", vbInformation
If k > 0 Or m > 0 Then MsgBox k & " substitutions made" & vbCr & _
m & " substitutions skipped", vbInformation
Exit Sub
End Sub

[Harry88]

That works fine. Thanks again.

[Harry88]

I have now made a Macro #4 based on Macro #2, with different characters to find and replace.



Sub Macro4()
Dim vFindText As Variant
Dim vReplaceText As Variant
Dim oRng As Range
Dim i As Integer, j As Integer, k As Integer, m As Integer
Dim lAsk As Long


vFindText = Array(Chr(176), Chr(186), Chr(111))
vReplaceText = Array(-3920, -3920, -3920)
j = 0: k = 0: m = 0
For i = 0 To UBound(vFindText)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = vFindText(i)
Do While .Execute
j = j + 1
oRng.Select
lAsk = MsgBox("Replace Symbol", vbYesNoCancel)
If lAsk = 2 Then GoTo lbl_Exit
If lAsk = 6 Then
k = k + 1
oRng.InsertSymbol Font:="Symbol", _
CharacterNumber:=vReplaceText(i), _
Unicode:=True
Else
m = m + 1
End If
oRng.Collapse 0
Loop
End With
Next i
lbl_Exit:
If j = 0 Then MsgBox "There are no matches", vbInformation
If k > 0 Or m > 0 Then MsgBox k & " substitutions made" & vbCr & _
m & " substitutions skipped", vbInformation
Exit Sub
End Sub


This version should find the degree symbol [Chr(176)], the masculine ordinal indicator [Chr(186)], and the letter o [Chr(111)] when it has superscript font formatting, and replace them all with the degree symbol inserted from the Symbol font. How do I specify the superscript font formatting for only the letter o; i.e., only the third item in the find array? (Can this be done by using an additional array to specify font formatting for each item in the find array; e.g., in this case "any" for the first and second items, and "superscript" for the third item?)

[gmayor]

You can add a condition to reflect the position in the array. In the macro, you have three elements i.e. i = 0 to 2. If you want something to apply only to the third element in the array then add a condition

If i = 2 then do something

i.e.

For i = 0 To UBound(vFindText)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = vFindText(i)
If i = 2 Then .Font.Superscript = True
Do While .Execute
j = j + 1
oRng.Select
lAsk = MsgBox("Replace Symbol", vbYesNoCancel)
If lAsk = 2 Then GoTo lbl_Exit
If lAsk = 6 Then
k = k + 1
If i = 2 Then oRng.Font.Superscript = False
oRng.InsertSymbol Font:="Symbol", _
CharacterNumber:=vReplaceText(i), _
Unicode:=True
Else
m = m + 1
End If
oRng.Collapse 0
Loop
End With
Next i

[Harry88]

That works fine. Thanks again.