Need a little help with Excel VBA

Benkyo · 8 June 2023 23:27

As already previously discussed a lot in the Workplace thread, I have a chore I need to do a lot and I need to speed it up. Taking this “public” to stop derailing that thread.

So far, the macro someone helpfully suggested is below.

Now I need to change “Range” to “ActiveWorkbook”, or equivalent, and to also change the font of any modifiedText to the Symbol font. Not having much luck in web-searching, and I don’t really want or need to learn VBA from scratch. Can anyone help out?

Sub ReplaceCharactersWithSymbols()
    Dim rng As Range
    Dim cell As Range
    Dim originalText As String
    Dim modifiedText As String
    
    ' Set the range where your data is located
    Set rng = Range("A1:A100") ' Update the range as per your data
    
    ' Loop through each cell in the range
    For Each cell In rng
        ' Get the original text from the cell
        originalText = cell.Value
        modifiedText = originalText
        
        ' Replace the characters with their corresponding symbols
        modifiedText = Replace(modifiedText, "°", "°")
        modifiedText = Replace(modifiedText, "×", "`")
        ' Add more Replace statements for each character you want to replace
        
        ' Update the cell value with the modified text
        cell.Value = modifiedText
    Next cell
End Sub

acharlie1377 · 9 June 2023 00:58

I’m a little fuzzy on VBA, but I think:

Replace Range("A1:A100") with ActiveSheet.Cells
After cell.Value = modifiedText, add the line cell.Font.Name = "Symbol" (or whatever the full font name is).

pillbox · 9 June 2023 01:10

This has always been my challenge with them, and why I didn’t suggest VBA as an approach to solving your particular problem. Probably the last thing you’d want to do is embed it in the workbook because then VBA security countermeasures are going to start interfering.

I think at one point I figured out how to have a VBA module always load regardless of the workbook(s) open, but I cannot recall how at the moment. I will try to jog my memory.

pillbox · 9 June 2023 01:33

Okay, I figured it out.

Open the VBA editor on a new workbook. Insert a new module.
In the module properties, name it something useful like “GlobalVBA”
Save the document (Save icon in VBA editor). In the Save dialog, in the “Save as type:” drop-down, choose “Excel Add-in (*.xlam)” – this should automatically change the save path to %APPDATA%\Roaming\Microsoft\Addins. Choose an appropriate name for the file, e.g. “GlobalVBA” and click Save
Go to File menu, then Options. Click Add-ins on the left.
At the bottom, there is a drop-down next to “*Manage:” – choose “Excel Add-ins” and click Go...
If your module is not already in the list, click Browse..., select the file you created previously and Open
Checkmark your module. I named mine “GlobalVBA” and it shows up as “Globalvba”

From here, depending on how you are structuring your automation, you can do a number of things. I made a test Subroutine/Macro and was able to add it to my “Quick Access Toolbar”. But I think you could make it a dialog or bind it to a keypress (using VBA in the global module)

Benkyo · 9 June 2023 03:18

Thanks all. I think I may have created an infinite loop with ActiveSheet.Cells as the range…

I think the font to Symbol is also being run for every cell?

Benkyo · 9 June 2023 03:24

Oh, hah, I’m probably not allowed to run VBA macros at all.

acharlie1377 · 9 June 2023 03:42

Sorry, that is my bad! I thought something was too easy about just using ActiveSheet.Cells…

Ah, I didn’t realize the font should only be changed if the cell is modified. I would suggest adding an if statement…

If modifiedText <> originalText Then cell.Font.Name = "Symbol"

… but I think I’ve caused enough damage here, so I will duck out before I destroy someone’s hard drive.

Benkyo · 9 June 2023 03:48

Thanks!

Just in case I do ever get to use this, I don’t want the cell to be changed to Symbol font when the text is modified, just the modified character.

Assussanni · 9 June 2023 16:51

If you still need this then I’ve got a couple of solutions that I think should work.

Solution 1: Use Regular Expressions. I think this will be faster but requires the additional following step: in the VBA window you’ll need to go to Tools → References… then scroll down until you find “Microsoft VBScript Regular Expressions 5.5” and enable it.

Code using Regular Expressions

Sub Test()

    Dim rng1, rng2, rng3 As Range
    Dim newText As String
    Dim regEx As New RegExp
    Dim mc As MatchCollection
    Dim m As Match
    Dim startPos As Long
        
    Application.ScreenUpdating = False
        
    Set rng1 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByRows, xlPrevious)
    Set rng2 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByColumns, xlPrevious)
    If Not rng1 Is Nothing Then
        Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
    Else
        MsgBox "Worksheet is empty", vbExclamation, "Error"
        Exit Sub
    End If
    
    regEx.Global = True
    regEx.Pattern = "z|y" ' Change to match the two symbols you want to insert.
        
    For Each cell In rng3
        If cell.Value <> "" Then
        ' Example code changes a -> z and y -> b.
        ' Change a and b to the symbols you want to replace and y and z to the symbols you want to insert.
            If InStr(cell.Value, "a") Or InStr(cell.Value, "b") Then
                newText = Replace(cell.Value, "a", "z")
                newText = Replace(newText, "b", "y")
                cell.Value = newText
                 
                Set mc = regEx.Execute(cell)
                For Each m In mc
                    startPos = m.FirstIndex
                    cell.Characters(startPos + 1, 1).Font.Name = "Symbol"
                Next m
                        
            End If
        End If
    Next cell
       
    Application.ScreenUpdating = True

End Sub

Solution 2: Use two while loops to change the font.

Code without Regular Expressions

Sub Test2()

    Dim rng1, rng2, rng3 As Range
    Dim newText As String
    Dim charPos As Long
        
    Application.ScreenUpdating = False
        
    Set rng1 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByRows, xlPrevious)
    Set rng2 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByColumns, xlPrevious)
    If Not rng1 Is Nothing Then
        Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
    Else
        MsgBox "Worksheet is empty", vbExclamation, "Error"
        Exit Sub
    End If
        
    For Each cell In rng3
        If cell.Value <> "" Then
        ' Example code changes a -> z and y -> b.
        ' Change a and b to the symbols you want to replace and y and z to the symbols you want to insert.
            If InStr(cell.Value, "a") Or InStr(cell.Value, "b") Then
                newText = Replace(cell.Value, "a", "z")
                newText = Replace(newText, "b", "y")
                cell.Value = newText
                
                charPos = InStr(cell.Value, "z")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "z")
                Loop
                
                charPos = InStr(cell.Value, "y")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "y")
                Loop
                        
            End If
        End If
    Next cell
       
    Application.ScreenUpdating = True

End Sub

Hopefully they still work with the actual symbols you want to replace and insert…

Benkyo · 9 June 2023 22:37

Very cool, thanks. For some reason I’m having trouble editing code in the VBA editor - everything locks up when I try and paste symbols from outside the editor - so I’m going to reproduce the desired code below:

symbols inserted

Sub Test()

    Dim rng1, rng2, rng3 As Range
    Dim newText As String
    Dim regEx As New RegExp
    Dim mc As MatchCollection
    Dim m As Match
    Dim startPos As Long
        
    Application.ScreenUpdating = False
        
    Set rng1 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByRows, xlPrevious)
    Set rng2 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByColumns, xlPrevious)
    If Not rng1 Is Nothing Then
        Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
    Else
        MsgBox "Worksheet is empty", vbExclamation, "Error"
        Exit Sub
    End If
    
    regEx.Global = True
    regEx.Pattern = "%|+|−|<|=|>|Δ|α|β|δ|ε|φ|λ|μ|π|θ|≤|°|±|≥|×|√|∑"
        
    For Each cell In rng3
        If cell.Value <> "" Then
            If InStr(cell.Value, "%") Or InStr(cell.Value, "+") Or InStr(cell.Value, "−") Or InStr(cell.Value, "<") Or InStr(cell.Value, "=") Or InStr(cell.Value, ">") Or InStr(cell.Value, "Δ") Or InStr(cell.Value, "α") Or InStr(cell.Value, "β") Or InStr(cell.Value, "δ") Or InStr(cell.Value, "ε") Or InStr(cell.Value, "φ") Or InStr(cell.Value, "λ") Or InStr(cell.Value, "μ") Or InStr(cell.Value, "π") Or InStr(cell.Value, "θ") Or InStr(cell.Value, "≤") Or InStr(cell.Value, "°") Or InStr(cell.Value, "±") Or InStr(cell.Value, "≥") Or InStr(cell.Value, "×") Or InStr(cell.Value, "√") Or InStr(cell.Value, "∑") Then
                newText = Replace(cell.Value, "%", "%")
                newText = Replace(cell.Value, "+", "+")
                newText = Replace(newText, "−", "-")
                newText = Replace(cell.Value, "<", "<")
                newText = Replace(newText, "=", "=")
                newText = Replace(cell.Value, ">", ">")
                newText = Replace(newText, "Δ", "D")
                newText = Replace(cell.Value, "α", "a")
                newText = Replace(newText, "β", "b")
                newText = Replace(cell.Value, "δ", "d")
                newText = Replace(newText, "ε", "e")
                newText = Replace(cell.Value, "φ", "j")
                newText = Replace(newText, "λ", "l")
                newText = Replace(cell.Value, "μ", "m")
                newText = Replace(newText, "π", "p")
                newText = Replace(cell.Value, "θ", "q")
                newText = Replace(newText, "≤", "£")
                newText = Replace(cell.Value, "°", "°")
                newText = Replace(newText, "±", "±")
                newText = Replace(cell.Value, "≥", "³")
                newText = Replace(newText, "×", "´")
                newText = Replace(cell.Value, "√", "Ö")
                newText = Replace(newText, "∑", "å")
                cell.Value = newText
                 
                Set mc = regEx.Execute(cell)
                For Each m In mc
                    startPos = m.FirstIndex
                    cell.Characters(startPos + 1, 1).Font.Name = "Symbol"
                Next m
                        
            End If
        End If
    Next cell
       
    Application.ScreenUpdating = True

End Sub

EDIT: With the above code I get

In doing this, I noted that there are a mixture of characters, some need to be changed when the Symbol font is applied, and some must not. I hope that isn’t the reason for the error.

I can’t see the reason for the difference in

                newText = Replace(cell.Value, "+", "+")
                newText = Replace(newText, "−", "-")

Why cell.Value in one and newText in the other? I hope that’s not indicative of a limitation to only replacing two character types.

I also note that VBA displays −, ≥, and ≤ as ?, ³ as 3, Ö as O, and å as a, so I assume those substitutions are impossible to implement correctly through a VBA macro.

I’m also concerned that because the Symbol font uses a for α, the code will change all the "a"s in the sheet to the Symbol font (i.e., all a would look like α).

Benkyo · 10 June 2023 08:36

OK, trying out the non-RegEx version and this works, and does a lot, already a big time-saver.

The outstanding problem is the way the Symbol font uses regular alphabet characters as α β δ etc., so if I convert them to a b d first, the loops to change those characters to the Symbol font will presumably pick up a lot of text I don’t want to convert! Conversely, those characters can’t be changed to the Symbol font first, because those characters don’t exist in the Symbol font!

So it looks like I need to link the processes. Find a target character, change it to the character it needs to be for the Symbol font, then immediately change the font, before moving onto the next target character. Does that make sense?

Current code

Sub MacroSubstitution2()

    Dim rng1, rng2, rng3 As Range
    Dim newText As String
    Dim charPos As Long
        
    Application.ScreenUpdating = False
        
    Set rng1 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByRows, xlPrevious)
    Set rng2 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByColumns, xlPrevious)
    If Not rng1 Is Nothing Then
        Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
    Else
        MsgBox "Worksheet is empty", vbExclamation, "Error"
        Exit Sub
    End If
        
    For Each cell In rng3
        If cell.Value <> "" Then
            If InStr(cell.Value, "%") Or InStr(cell.Value, "+") Or InStr(cell.Value, "<") Or InStr(cell.Value, "=") Or InStr(cell.Value, ">") Or InStr(cell.Value, "Δ") Or InStr(cell.Value, "α") Or InStr(cell.Value, "β") Or InStr(cell.Value, "δ") Or InStr(cell.Value, "ε") Or InStr(cell.Value, "φ") Or InStr(cell.Value, "λ") Or InStr(cell.Value, "μ") Or InStr(cell.Value, "π") Or InStr(cell.Value, "θ") Or InStr(cell.Value, "°") Or InStr(cell.Value, "±") Or InStr(cell.Value, "×") Then
                newText = Replace(cell.Value, "Δ", "D")
                newText = Replace(cell.Value, "α", "a")
                newText = Replace(cell.Value, "β", "b")
                newText = Replace(cell.Value, "δ", "d")
                newText = Replace(cell.Value, "ε", "e")
                newText = Replace(cell.Value, "φ", "j")
                newText = Replace(cell.Value, "λ", "l")
                newText = Replace(cell.Value, "μ", "m")
                newText = Replace(cell.Value, "π", "p")
                newText = Replace(cell.Value, "θ", "q")
                newText = Replace(cell.Value, "×", "´")
                cell.Value = newText
                
                charPos = InStr(cell.Value, "%")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "%")
                Loop
                
                charPos = InStr(cell.Value, "+")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "+")
                Loop
                
                charPos = InStr(cell.Value, "<")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "<")
                Loop
                
                charPos = InStr(cell.Value, "=")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "=")
                Loop            
   
                charPos = InStr(cell.Value, ">")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, ">")
                Loop
                
                charPos = InStr(cell.Value, "°")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "°")
                Loop               
 
                charPos = InStr(cell.Value, "±")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "±")
                Loop
                
                charPos = InStr(cell.Value, "´")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "´")
                Loop                
        
            End If
        End If
    Next cell
       
    Application.ScreenUpdating = True

End Sub

Benkyo · 10 June 2023 12:19

I think I have something that works?

This is of course completely hacked together with little understanding of what I am doing, but it seems to work!

If you have a moment, @Assussanni , a quick look to tell me if this will run into any problems, or could be done more reliably, would be much appreciated. Thank you so much for providing the code.

I have created a monster!

Sub MacroSubstitution3()

    Dim rng1, rng2, rng3 As Range
    Dim newText As String
    Dim charPos As Long
        
    Application.ScreenUpdating = False
        
    Set rng1 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByRows, xlPrevious)
    Set rng2 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByColumns, xlPrevious)
    If Not rng1 Is Nothing Then
        Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
    Else
        MsgBox "Worksheet is empty", vbExclamation, "Error"
        Exit Sub
    End If
        
    For Each cell In rng3
        If cell.Value <> "" Then
            If InStr(cell.Value, "%") Or InStr(cell.Value, "λ") Or InStr(cell.Value, "Δ") Or InStr(cell.Value, "α") Or InStr(cell.Value, "β") Or InStr(cell.Value, "δ") Or InStr(cell.Value, "ε") Or InStr(cell.Value, "φ") Or InStr(cell.Value, "μ") Or InStr(cell.Value, "π") Or InStr(cell.Value, "θ") Or InStr(cell.Value, "+") Or InStr(cell.Value, "<") Or InStr(cell.Value, "=") Or InStr(cell.Value, ">") Or InStr(cell.Value, "°") Or InStr(cell.Value, "±") Or InStr(cell.Value, "×") Then
                newText = Replace(cell.Value, "×", "´")
                cell.Value = newText
                
                charPos = InStr(cell.Value, "%")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "%")
                Loop
                
                charPos = InStr(cell.Value, "λ")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "λ")
                newText = Replace(cell.Value, "λ", "l")
                cell.Value = newText
                Loop
                                
                charPos = InStr(cell.Value, "Δ")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "Δ")
                newText = Replace(cell.Value, "Δ", "D")
                cell.Value = newText
                Loop
                
                charPos = InStr(cell.Value, "α")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "α")
                newText = Replace(cell.Value, "α", "a")
                cell.Value = newText
                Loop
                                
                charPos = InStr(cell.Value, "β")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "β")
                newText = Replace(cell.Value, "β", "b")
                cell.Value = newText
                Loop
                                
                charPos = InStr(cell.Value, "δ")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "δ")
                newText = Replace(cell.Value, "δ", "d")
                cell.Value = newText
                Loop
                
                charPos = InStr(cell.Value, "ε")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "ε")
                newText = Replace(cell.Value, "ε", "e")
                cell.Value = newText
                Loop
               
                charPos = InStr(cell.Value, "φ")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "φ")
                newText = Replace(cell.Value, "φ", "j")
                cell.Value = newText
                Loop
                
                charPos = InStr(cell.Value, "μ")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "μ")
                newText = Replace(cell.Value, "μ", "m")
                cell.Value = newText
                Loop
                
                charPos = InStr(cell.Value, "π")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "π")
                newText = Replace(cell.Value, "π", "p")
                cell.Value = newText
                Loop
                
                charPos = InStr(cell.Value, "θ")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "θ")
                newText = Replace(cell.Value, "θ", "q")
                cell.Value = newText
                Loop
                 
                charPos = InStr(cell.Value, "+")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "+")
                Loop
                
                charPos = InStr(cell.Value, "<")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "<")
                Loop
                
                charPos = InStr(cell.Value, "=")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "=")
                Loop
   
                charPos = InStr(cell.Value, ">")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, ">")
                Loop
                
                charPos = InStr(cell.Value, "°")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "°")
                Loop
 
                charPos = InStr(cell.Value, "±")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "±")
                Loop
                
                charPos = InStr(cell.Value, "´")
                Do While charPos > 0
                    cell.Characters(charPos, 1).Font.Name = "Symbol"
                    charPos = InStr(charPos + 1, cell.Value, "´")
                Loop
        
            End If
        End If
    Next cell
       
    Application.ScreenUpdating = True

End Sub

Assussanni · 10 June 2023 15:44

From what I can see, that will work as long as there are no more than two of the same character that you want replaced in any given cell. If there are, then I think you need to move the two lines that do the replacement outside the do while loop.

If that causes font issues (I had some inconsistent issues with Replace changing fonts) then I think they could be fixed with:

Code for if Replace starts causing issues with the fonts

Firstly, add “Dim originalText As String” up at the top with the other declarations.
Change the following lines in this location:

newText = Replace(cell.Value, "×", "´")
cell.Value = newText
originalText = newText

Then change the loops that use Replace to look like this:

newText = Replace(cell.Value, "λ", "l")
cell.Value = newText
charPos = InStr(originalText, "λ")
Do While charPos > 0
    cell.Characters(charPos, 1).Font.Name = "Symbol"
    charPos = InStr(charPos + 1, originalText, "λ")
Loop

If you’re interested in neatening it up and making it easier to modify in future, then perhaps the following helps (but feel free to ignore!):

Macro to Call Macros

Sub MacroSubstitution4()

    Dim rng1, rng2, rng3 As Range
    Dim newText As String
        
    ' Turn off screen updating for performance gains.
    Application.ScreenUpdating = False
        
    ' Find range to search over.
    Set rng1 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByRows, xlPrevious)
    Set rng2 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByColumns, xlPrevious)
    If Not rng1 Is Nothing Then
        Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
    Else
        MsgBox "Worksheet is empty", vbExclamation, "Error"
        Exit Sub
    End If
        
    ' Loop over cells in range.
    For Each cell In rng3
        ' Only check non-empty cells.
        If cell.Value <> "" Then
        
        ' I removed the big If ... Or ... Or ... statement from here. If it was making the code faster feel free to keep it/add it back in.

            newText = Replace(cell.Value, "×", "´")
            cell.Value = newText
               
            Call ConvertToSymbol(cell, "%")
            Call ConvertToSymbolAndReplace(cell, "λ", "l")
            Call ConvertToSymbolAndReplace(cell, "Δ", "D")
            Call ConvertToSymbolAndReplace(cell, "α", "a")
            Call ConvertToSymbolAndReplace(cell, "β", "b")
            Call ConvertToSymbolAndReplace(cell, "δ", "d")
            Call ConvertToSymbolAndReplace(cell, "ε", "e")
            Call ConvertToSymbolAndReplace(cell, "φ", "j")
            Call ConvertToSymbolAndReplace(cell, "μ", "m")
            Call ConvertToSymbolAndReplace(cell, "π", "p")
            Call ConvertToSymbolAndReplace(cell, "θ", "q")
            Call ConvertToSymbol(cell, "+")
            Call ConvertToSymbol(cell, "<")
            Call ConvertToSymbol(cell, "=")
            Call ConvertToSymbol(cell, ">")
            Call ConvertToSymbol(cell, "°")
            Call ConvertToSymbol(cell, "±")
            Call ConvertToSymbol(cell, "´")

        End If
    Next cell
       
    Application.ScreenUpdating = True

End Sub

Sub ConvertToSymbolAndReplace(ByRef thisCell As Variant, ByVal inputChar As String, ByVal outputChar As String)

    Dim charPos As Long
    
    charPos = InStr(thisCell.Value, inputChar)
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Text = outputChar ' I found Replace didn't work properly here, this should do the same job.
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, inputChar)
    Loop
    
End Sub

Sub ConvertToSymbol(ByRef thisCell As Variant, ByVal inputChar As String)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, inputChar)
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, inputChar)
    Loop

End Sub

I think you also had a question about symbols which the VBA editor cannot display. The answer is that the same approach can work, but you have to define the characters of interest differently.

By way of example, let’s say we want to make all ≤ into Symbol font and convert all å into Ö. First, we need to look up the character code for these. In Excel, I went to Insert → Symbol… and selected the character of interest. In the bottom right, there is a four digit hexadecimal character code.

For ≤ this is 2264, å is (00)E5 and Ö is (00)D6.

I define three new subroutines which look like this:

Unicode Subroutines

Sub ReplaceUnicode(ByRef thisCell As Variant, ByVal inputCharCode As Long, ByVal outputCharCode As Long)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, ChrW(inputCharCode))
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Text = ChrW(outputCharCode)
        charPos = InStr(charPos + 1, thisCell.Value, ChrW(inputCharCode))
    Loop

End Sub

Sub ConvertToSymbolUnicode(ByRef thisCell As Variant, ByVal inputCharCode As Long)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, ChrW(inputCharCode))
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, ChrW(inputCharCode))
    Loop

End Sub

Sub ConvertToSymbolAndReplaceUnicode(ByRef thisCell As Variant, ByVal inputCharCode As Long, ByVal outputCharCode As Long)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, ChrW(inputCharCode))
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Text = ChrW(outputCharCode)
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, ChrW(inputCharCode))
    Loop

End Sub

I then use these by entering the character code preceded by &H to tell Excel that these are hexadecimal numbers.

So we could add:

Call ConvertToSymbolUnicode(cell, &H2264)
Call ReplaceUnicode(cell, &HE5, &HD6)

to our previous list of Calls to achieve our goal.

Benkyo · 10 June 2023 20:22

Dim Wizard As Awesome
Dim Assussanni As Wizard

For my own reference, the full thing in all its glory

Sub SymbolSubstitution()

    Dim rng1, rng2, rng3 As Range
    Dim newText As String
        
    Application.ScreenUpdating = False
        
    ' Find range to search over.
    Set rng1 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByRows, xlPrevious)
    Set rng2 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByColumns, xlPrevious)
    If Not rng1 Is Nothing Then
        Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
    Else
        MsgBox "Worksheet is empty", vbExclamation, "Error"
        Exit Sub
    End If
        
    ' Loop over cells in range.
    For Each cell In rng3
        ' Only check non-empty cells.
        If cell.Value <> "" Then


            Call ConvertToSymbolAndReplace(cell, "Δ", "D")
            Call ConvertToSymbolAndReplace(cell, "Φ", "F")
            Call ConvertToSymbolAndReplace(cell, "Ω", "W")
            Call ConvertToSymbolAndReplace(cell, "α", "a")
            Call ConvertToSymbolAndReplace(cell, "β", "b")
            Call ConvertToSymbolAndReplace(cell, "χ", "c")
            Call ConvertToSymbolAndReplace(cell, "δ", "d")
            Call ConvertToSymbolAndReplace(cell, "ε", "e")
            Call ConvertToSymbolAndReplace(cell, "η", "h")
            Call ConvertToSymbolAndReplace(cell, "φ", "j")
            Call ConvertToSymbolAndReplace(cell, "λ", "l")
            Call ConvertToSymbolAndReplace(cell, "μ", "m")
            Call ConvertToSymbolAndReplace(cell, "π", "p")
            Call ConvertToSymbolAndReplace(cell, "θ", "q")
            Call ConvertToSymbolAndReplace(cell, "×", "´")
            Call ConvertToSymbol(cell, "~")
            Call ConvertToSymbol(cell, "&")
            Call ConvertToSymbol(cell, "+")
            Call ConvertToSymbol(cell, "%")
            Call ConvertToSymbol(cell, "<")
            Call ConvertToSymbol(cell, "=")
            Call ConvertToSymbol(cell, ">")
            Call ConvertToSymbol(cell, "°")
            Call ConvertToSymbol(cell, "±")
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2219, &HD7) ' Bullet (must run after × to ´)
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2211, &H53) ' Sum/sigma sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2212, &H2D) ' Minus sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2264, &HA3) ' Less than or equal sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2265, &HB3) ' Greater than or equal sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H221A, &HD6) ' Square root sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H221E, &HA5) ' Infinity sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H222B, &HF2) ' Integral sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2206, &H44) ' Alternative Delta sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H192, &HA6) ' Function sign

        End If
    Next cell
       
    Application.ScreenUpdating = True

End Sub

Sub ConvertToSymbolAndReplace(ByRef thisCell As Variant, ByVal inputChar As String, ByVal outputChar As String)

    Dim charPos As Long
    
    charPos = InStr(thisCell.Value, inputChar)
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Text = outputChar
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, inputChar)
    Loop
    
End Sub

Sub ConvertToSymbol(ByRef thisCell As Variant, ByVal inputChar As String)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, inputChar)
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, inputChar)
    Loop

End Sub

Sub ConvertToSymbolAndReplaceUnicode(ByRef thisCell As Variant, ByVal inputCharCode As Long, ByVal outputCharCode As Long)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, ChrW(inputCharCode))
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Text = ChrW(outputCharCode)
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, ChrW(inputCharCode))
    Loop

End Sub

Benkyo · 10 June 2023 22:31

@pillbox this is also great, thank you.

It seems that when I do this though, the Add-In I make is also inextricably linked to the new blank workbook that was open when I made it? Not sure exactly what the issue was, but until I saved the workbook separately from the Add-In module, the Add-In wouldn’t work when I tried to run it from the toolbar.

Not a big deal, but could be a wrinkle that prevents me from sharing my VBA code with colleagues, if that’s a thing I decide to do.

Benkyo · 13 June 2023 03:16

@Assussanni
In field-testing this, I found that sometimes our worksheets have hidden rows and columns containing… something… that causes the macro to break the sheet beyond repair when I run it. The sheet cannot be saved, or recovered.

I think that something is just Japanese text and/or formula.

Deleting hidden cells is part of the process to finishing the translation, so this isn’t a huge problem, but in order to foolproof things, is there some way to narrow the target cells down to not-hidden cells?

Maybe not doing anything in a cell that contains a formula or Japanese?

Also, and I know this is a trickier proposition, something to stop the calls from converting a character already in the Symbol font would be nice. Running the macro twice can have some unfortunate effects with chaining character swaps.

Assussanni · 13 June 2023 18:44

Big caveat, I haven’t had time to test any of this.

If the problem is only with things in hidden cells, then I think the following should solve the issue:

Between For Each cell In rng3 and If cell.Value <> “” Then, add:

If cell.EntireRow.Hidden = False And cell.EntireColumn.Hidden = False Then

and the corresponding End If at the end between End If and Next cell.
I believe that should stop the macro executing on any hidden cells.

If it is not hidden cells but something else, e.g. Japanese text, then I’ll have to have a think. If there is a specific font that your Japanese text is in, then it should be possible to use the If statement described next to check if the cell has that font, and if so skip it.

I think to skip things already in Symbol font, you’ll have to change the Replace() function to the alternative I suggested earlier.

It will end up looking something like this:

charPos = InStr(cell.Value, "λ")
Do While charPos > 0
    If cell.Characters(charPos, 1).Font.Name <> "Symbol" Then ' Only execute code if font is not already Symbol. 
        cell.Characters(charPos, 1).Text = "l"
        cell.Characters(charPos, 1).Font.Name = "Symbol"
    End If
    charPos = InStr(charPos + 1, cell.Value, "λ")
Loop

I’m less sure about this one, but it looks like it should work…

(For the Japanese font check it would be cell.Font.Name <> “[Japanese Font Name]”, you shouldn’t need the .Characters there.)

Benkyo · 13 June 2023 20:41

Awesome, both the hidden cell skipping and the Symbol font skipping seem to work just fine, and Japanese characters don’t seem to trigger any problems.

Turns out it wasn’t hidden cells that were the real problem though - it was formula. Skipping formula in hidden cells is already great, but if there’s a way to skip formula in unhidden cells too, please let me know!

~~For one final flourish, is there a way to turn a dual-width character like ℃ into ° (Symbol font) and C (Times New Roman font) so ℃ becomes °C?~~ Did this myself, feeling proud =)

Current code

Sub SymbolSubstitution()

    Dim rng1, rng2, rng3 As Range
    Dim newText As String
        
    Application.ScreenUpdating = False
        
    ' Find range to search over.
    Set rng1 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByRows, xlPrevious)
    Set rng2 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByColumns, xlPrevious)
    If Not rng1 Is Nothing Then
        Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
    Else
        MsgBox "Worksheet is empty", vbExclamation, "Error"
        Exit Sub
    End If
        
    ' Loop over cells in range.
    For Each cell In rng3
        ' Skip hidden cells
        If cell.EntireRow.Hidden = False And cell.EntireColumn.Hidden = False Then
            ' Only check non-empty cells.
            If cell.Value <> "" Then

                Call ConvertToSymbolAndReplace(cell, "Δ", "D")
                Call ConvertToSymbolAndReplace(cell, "Φ", "F")
                Call ConvertToSymbolAndReplace(cell, "Ω", "W")
                Call ConvertToSymbolAndReplace(cell, "α", "a")
                Call ConvertToSymbolAndReplace(cell, "β", "b")
                Call ConvertToSymbolAndReplace(cell, "χ", "c")
                Call ConvertToSymbolAndReplace(cell, "δ", "d")
                Call ConvertToSymbolAndReplace(cell, "ε", "e")
                Call ConvertToSymbolAndReplace(cell, "φ", "f")
                Call ConvertToSymbolAndReplace(cell, "γ", "g")
                Call ConvertToSymbolAndReplace(cell, "η", "h")
                Call ConvertToSymbolAndReplace(cell, "ι", "i")
                Call ConvertToSymbolAndReplace(cell, "φ", "j")
                Call ConvertToSymbolAndReplace(cell, "κ", "k")
                Call ConvertToSymbolAndReplace(cell, "λ", "l")
                Call ConvertToSymbolAndReplace(cell, "μ", "m")
                Call ConvertToSymbolAndReplace(cell, "ν", "n")
                Call ConvertToSymbolAndReplace(cell, "ο", "o")
                Call ConvertToSymbolAndReplace(cell, "π", "p")
                Call ConvertToSymbolAndReplace(cell, "θ", "q")
                Call ConvertToSymbolAndReplace(cell, "ρ", "r")
                Call ConvertToSymbolAndReplace(cell, "σ", "s")
                Call ConvertToSymbolAndReplace(cell, "τ", "t")
                Call ConvertToSymbolAndReplace(cell, "υ", "u")
                Call ConvertToSymbolAndReplace(cell, "ω", "w")
                Call ConvertToSymbolAndReplace(cell, "ξ", "x")
                Call ConvertToSymbolAndReplace(cell, "ψ", "y")
                Call ConvertToSymbolAndReplace(cell, "ζ", "z")
                Call ConvertToSymbolAndReplace(cell, "×", "´")
                Call ConvertToSymbol(cell, "~")
                Call ConvertToSymbol(cell, "&")
                Call ConvertToSymbol(cell, "+")
                Call ConvertToSymbol(cell, "%")
                Call ConvertToSymbol(cell, "<")
                Call ConvertToSymbol(cell, "=")
                Call ConvertToSymbol(cell, ">")
                Call ConvertToSymbol(cell, "°")
                Call ConvertToSymbol(cell, "±")
                Call ConvertToSymbolAndReplaceUnicode(cell, &H2219, &HD7) ' Small dot operator (must run after × to ´)
                Call ConvertToSymbolAndReplaceUnicode(cell, &H2E31, &HD7) ' Small dot operator
                Call ConvertToSymbolAndReplaceUnicode(cell, &HB7, &HD7)   ' Small dot operator
                Call ConvertToSymbolAndReplaceUnicode(cell, &H2027, &HD7) ' Small dot operator
                Call ConvertToSymbolAndReplaceUnicode(cell, &H2022, &HB7) ' Large bullet (must run after HB7 to HD7)
                Call ConvertToSymbolAndReplaceUnicode(cell, &H2211, &H53) ' Sum/sigma sign
                Call ConvertToSymbolAndReplaceUnicode(cell, &H2212, &H2D) ' Minus sign
                Call ConvertToSymbolAndReplaceUnicode(cell, &H2264, &HA3) ' Less than or equal sign
                Call ConvertToSymbolAndReplaceUnicode(cell, &H2265, &HB3) ' Greater than or equal sign
                Call ConvertToSymbolAndReplaceUnicode(cell, &H221A, &HD6) ' Square root sign
                Call ConvertToSymbolAndReplaceUnicode(cell, &H221E, &HA5) ' Infinity sign
                Call ConvertToSymbolAndReplaceUnicode(cell, &H222B, &HF2) ' Integral sign
                Call ConvertToSymbolAndReplaceUnicode(cell, &H2206, &H44) ' Alternative Delta sign
                Call ConvertToSymbolAndReplaceUnicode(cell, &H192, &HA6)  ' Function sign
                Call ConvertToSymbolAndReplaceUnicode(cell, &H3D5, &H66)  ' Alternative phi
                Call ConvertToSymbolAndReplaceUnicode(cell, &H3D6, &H76)  ' Greek Pi
                Call ConvertToSymbolAndReplaceUnicode(cell, &H251, &H61)  ' Latin alpha
                Call ConvertToSymbolAndReplaceUnicode(cell, &H25B, &H65)  ' Latin epsilon
                Call ConvertToSymbolAndReplaceUnicode(cell, &H269, &H69)  ' Latin i
                Call ConvertToSymbolAndReplaceUnicode(cell, &H275, &H71)  ' Latin theta
                Call ConvertToSymbolAndReplaceUnicode(cell, &H277, &H77)  ' Latin omega
                Call ConvertToSymbolAndReplaceUnicode(cell, &H278, &H66)  ' Latin phi
                Call ConvertToSymbolAndReplaceUnicode(cell, &H28B, &H75)  ' Latin u
                Call ConvertToSymbolAndReplaceUnicode(cell, &H2248, &HBB) ' Almost equal
                Call ConvertToSymbolAndReplaceUnicode(cell, &H2260, &HB9) ' Not equal
                Call ConvertToSymbolAndReplaceUnicode(cell, &H2261, &HBA) ' Indentical to
                Call ConvertToSymbolAndReplaceUnicode(cell, &HF7, &HB8)   ' Division sign
                Call ConvertCelsius(cell, &H2103, &HB0, &H43)  ' Celsius sign

            End If
        End If
    Next cell
       
    Application.ScreenUpdating = True

End Sub

Sub ConvertToSymbolAndReplace(ByRef thisCell As Variant, ByVal inputChar As String, ByVal outputChar As String)

    Dim charPos As Long
    
    charPos = InStr(thisCell.Value, inputChar)
    
    Do While charPos > 0
        If thisCell.Characters(charPos, 1).Font.Name <> "Symbol" Then ' Only execute code if font is not already Symbol.
            thisCell.Characters(charPos, 1).Text = outputChar
            thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        End If
        charPos = InStr(charPos + 1, thisCell.Value, inputChar)
    Loop
    
End Sub

Sub ConvertToSymbol(ByRef thisCell As Variant, ByVal inputChar As String)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, inputChar)
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, inputChar)
    Loop

End Sub

Sub ConvertToSymbolAndReplaceUnicode(ByRef thisCell As Variant, ByVal inputCharCode As Long, ByVal outputCharCode As Long)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, ChrW(inputCharCode))
    
    Do While charPos > 0
        If thisCell.Characters(charPos, 1).Font.Name <> "Symbol" Then ' Only execute code if font is not already Symbol.
            thisCell.Characters(charPos, 1).Text = ChrW(outputCharCode)
            thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        End If
        charPos = InStr(charPos + 1, thisCell.Value, ChrW(inputCharCode))
    Loop

End Sub

Sub ConvertCelsius(ByRef thisCell As Variant, ByVal inputCharCode As Long, ByVal outputCharCode As Long, ByVal outputCharCode2 As Long)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, ChrW(inputCharCode))
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Text = ChrW(outputCharCode)
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = charPos + 1
        thisCell.Characters(charPos, 1).Text = ChrW(outputCharCode2)
        thisCell.Characters(charPos, 1).Font.Name = "Times New Roman"
        charPos = InStr(charPos + 1, thisCell.Value, ChrW(inputCharCode))
    Loop

End Sub

Assussanni · 13 June 2023 21:57

Nice! For checking whether a cell contains a formula, it looks like there is a .HasFormula property.

How about trying to add this check to where we test that a cell isn’t empty? Something like:

If cell.Value <> “” And Not cell.HasFormula Then

If that doesn’t work then perhaps something like this would be a workaround, given that I believe Excel formulae always start with =

If cell.Value <> “” And Left(cell.Formula, 1) <> “=“ Then

(NB I’m typing on an iPad, which I think might use a different symbol for double quotes. You may need to replace these for them to work properly if you copy and paste.)

Benkyo · 13 June 2023 22:09

The latter option seems to have worked. Thanks again! Honestly, you have probably bumped up my income by a not-insignificant amount with this.