Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 23

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

  1. #1
    VBAX Regular
    Joined
    Oct 2022
    Posts
    24
    Location

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

    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?

  2. #2
    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.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Oct 2022
    Posts
    24
    Location
    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.

    Test document.docx

    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?

  4. #4
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,379
    Location
    How will you know in what section the find and replace would occur?
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  5. #5
    VBAX Regular
    Joined
    Oct 2022
    Posts
    24
    Location
    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.

  6. #6
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,379
    Location
    How would you know which one it has found and is asking if you want to replace it?
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  7. #7
    VBAX Regular
    Joined
    Oct 2022
    Posts
    24
    Location
    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.

  8. #8
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,379
    Location
    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?
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  9. #9
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,379
    Location
    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?
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  10. #10
    VBAX Regular
    Joined
    Oct 2022
    Posts
    24
    Location
    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.

  11. #11
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  12. #12
    VBAX Regular
    Joined
    Oct 2022
    Posts
    24
    Location
    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?

  13. #13
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,379
    Location
    Have you tried?
    oRng.Font.Name = "Symbol", CharacterNumber:=-3920, Unicode:=True"
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  14. #14
    VBAX Regular
    Joined
    Oct 2022
    Posts
    24
    Location
    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.

  15. #15
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  16. #16
    VBAX Regular
    Joined
    Oct 2022
    Posts
    24
    Location
    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?
    Last edited by Harry88; 02-08-2023 at 01:32 AM.

  17. #17
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  18. #18
    VBAX Regular
    Joined
    Oct 2022
    Posts
    24
    Location
    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.
    Test document2.docx

  19. #19
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  20. #20
    VBAX Regular
    Joined
    Oct 2022
    Posts
    24
    Location
    That works fine. Thanks again.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •