No problem, happy to help. I had to teach myself VBA for a summer project 15 or so years ago and only occasionally manage to find opportunities to use it these days.
It runs really slowly, is a pain to debug and the documentation is often unhelpful… but it can be incredibly useful in the right circumstances and I like it for how readable the code is for an inexperienced user even gasp without many/any comments.
Something about my code to convert the ℃ symbol is causing trouble. When I have a cell that is (℃), the desired output is (°C) but I get (°C with the second bracket dropped. This is probably happening because of the hacked-together way I did it, advancing the charPos and overwriting the character after the ℃, but what should I be doing to insert the second character instead of overwriting?
Call ConvertCelsius(cell, &H2103, &HB0, &H43) ' Double Celsius
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
EDIT: resolved it myself, yay =)
Call ConvertCelsius(cell, &H2103, "°C") ' Double Celsius
Sub ConvertCelsius(ByRef thisCell As Variant, ByVal inputCharCode As Long, ByVal outputChar As String)
Dim charPos As Long
charPos = InStr(thisCell.Value, ChrW(inputCharCode))
Do While charPos > 0
thisCell.Characters(charPos, 1).Text = outputChar
thisCell.Characters(charPos, 1).Font.Name = "Symbol"
charPos = charPos + 1
thisCell.Characters(charPos, 1).Font.Name = "Times New Roman"
charPos = InStr(charPos + 1, thisCell.Value, ChrW(inputCharCode))
Loop
End Sub
Returning to this almost a year later, is there an easy way to convert this into a Word-friendly macro that would do the same thing for a Word file?
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 without formula
If cell.Value <> "" And Left(cell.Formula, 1) <> "=" 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, &H2DA, &HB0) ' Diacritic to celcius
Call ConvertToSymbolAndReplaceUnicode(cell, &H2219, &HD7) ' Small dot (after × to ´)
Call ConvertToSymbolAndReplaceUnicode(cell, &H2E31, &HD7) ' Small dot
Call ConvertToSymbolAndReplaceUnicode(cell, &HB7, &HD7) ' Small dot
Call ConvertToSymbolAndReplaceUnicode(cell, &H2027, &HD7) ' Small dot
Call ConvertToSymbolAndReplaceUnicode(cell, &HFF65, &HD7) ' Small dot
Call ConvertToSymbolAndReplaceUnicode(cell, &H22C5, &HD7) ' Small dot
Call ConvertToSymbolAndReplaceUnicode(cell, &H2022, &HB7) ' Bullet (after HB7 to HD7)
Call ConvertToSymbolAndReplaceUnicode(cell, &H2211, &H53) ' Sum/sigma
Call ConvertToSymbolAndReplaceUnicode(cell, &H2212, &H2D) ' Minus
Call ConvertToSymbolAndReplaceUnicode(cell, &H2264, &HA3) ' <=
Call ConvertToSymbolAndReplaceUnicode(cell, &H2266, &HA3) ' Double <=
Call ConvertToSymbolAndReplaceUnicode(cell, &H2265, &HB3) ' >=
Call ConvertToSymbolAndReplaceUnicode(cell, &H2267, &HB3) ' Double >=
Call ConvertToSymbolAndReplaceUnicode(cell, &H221A, &HD6) ' Square root
Call ConvertToSymbolAndReplaceUnicode(cell, &H221E, &HA5) ' Infinity
Call ConvertToSymbolAndReplaceUnicode(cell, &H222B, &HF2) ' Integral
Call ConvertToSymbolAndReplaceUnicode(cell, &H2206, &H44) ' Alternative Δ
Call ConvertToSymbolAndReplaceUnicode(cell, &H192, &HA6) ' Function
Call ConvertToSymbolAndReplaceUnicode(cell, &H3D5, &H66) ' Alternative φ
Call ConvertToSymbolAndReplaceUnicode(cell, &H3D6, &H76) ' Greek Pi
Call ConvertToSymbolAndReplaceUnicode(cell, &H251, &H61) ' Latin α
Call ConvertToSymbolAndReplaceUnicode(cell, &H25B, &H65) ' Latin ε
Call ConvertToSymbolAndReplaceUnicode(cell, &H269, &H69) ' Latin ι
Call ConvertToSymbolAndReplaceUnicode(cell, &H275, &H71) ' Latin θ
Call ConvertToSymbolAndReplaceUnicode(cell, &H277, &H77) ' Latin Ω
Call ConvertToSymbolAndReplaceUnicode(cell, &H278, &H66) ' Latin φ
Call ConvertToSymbolAndReplaceUnicode(cell, &H28B, &H75) ' Latin υ
Call ConvertToSymbolAndReplaceUnicode(cell, &H2248, &HBB) ' Almost equal
Call ConvertToSymbolAndReplaceUnicode(cell, &H2260, &HB9) ' Not equal
Call ConvertToSymbolAndReplaceUnicode(cell, &H2261, &HBA) ' Identical to
Call ConvertToSymbolAndReplaceUnicode(cell, &HF7, &HB8) ' Division
Call ConvertToSymbolAndReplaceUnicode(cell, &HB5, &H6D) ' Alternative μ
Call ConvertToSymbolAndReplaceUnicode(cell, &HFF5E, &H7E) ' Double ~
Call ConvertToSymbolAndReplaceUnicode(cell, &HFF05, &H25) ' Double %
Call ConvertToSymbolAndReplaceUnicode(cell, &HFF1D, &H3D) ' Double =
Call ConvertToSymbolAndReplaceUnicode(cell, &HFF1C, &H3C) ' Double <
Call ConvertToSymbolAndReplaceUnicode(cell, &HFF1E, &H3E) ' Double >
Call ConvertToSymbolAndReplaceUnicode(cell, &HFF0B, &H2B) ' Double +
Call ConvertToSymbolAndReplaceUnicode(cell, &HFF0D, &H2D) ' Double -
Call ConvertToSymbolAndReplaceUnicode(cell, &H2282, &HC9) ' subset of
Call ConvertToSymbolAndReplaceUnicode(cell, &H2234, &H5C) ' Therefore
Call ConvertToSymbolAndReplaceUnicode(cell, &H2190, &HAC) ' left arrow
Call ConvertToSymbolAndReplaceUnicode(cell, &HFFE9, &HAC) ' left arrow
Call ConvertToSymbolAndReplaceUnicode(cell, &H2191, &HAD) ' up arrow
Call ConvertToSymbolAndReplaceUnicode(cell, &HFFEA, &HAD) ' up arrow
Call ConvertToSymbolAndReplaceUnicode(cell, &H2191, &HAE) ' right arrow
Call ConvertToSymbolAndReplaceUnicode(cell, &HFFEB, &HAE) ' right arrow
Call ConvertToSymbolAndReplaceUnicode(cell, &H2193, &HAF) ' down arrow
Call ConvertToSymbolAndReplaceUnicode(cell, &HFFEC, &HAF) ' down arrow
Call ConvertToSymbolAndReplaceUnicode(cell, &H2194, &HAB) ' double arrow
Call ConvertToSymbolAndReplaceUnicode(cell, &H2203, &H24) ' there exists
Call ConvertToSymbolAndReplaceUnicode(cell, &H2208, &HCE) ' element of
Call ConvertToSymbolAndReplaceUnicode(cell, &H220A, &HCE) ' element of
Call ConvertToSymbolAndReplaceUnicode(cell, &H2209, &HCF) ' not element of
Call ConvertToSymbolAndReplaceUnicode(cell, &H2207, &HD1) ' nabla
Call ConvertToSymbolAndReplaceUnicode(cell, &HA9, &HD3) ' copyright
Call ConvertToSymbolAndReplaceUnicode(cell, &HAE, &HD2) ' registered
Call ConvertToSymbolAndReplaceUnicode(cell, &H2212, &HD4) ' tm
Call ConvertToSymbolAndReplaceUnicode(cell, &H2229, &HC7) ' intersection
Call ConvertToSymbolAndReplaceUnicode(cell, &H2283, &HCC) ' superset of
Call ConvertToSymbolAndReplaceUnicode(cell, &H2245, &H40) ' approx
Call ConvertToSymbolAndReplaceUnicode(cell, &HFF06, &H26) ' Double &
Call ConvertTNRAndReplace(cell, &HFF1A, &H3A) ' Double :
Call ConvertTNRAndReplace(cell, &H2236, &H3A) ' Double :
Call ConvertTNRAndReplace(cell, &HFF08, &H28) ' Double (
Call ConvertTNRAndReplace(cell, &HFF09, &H29) ' Double )
Call ConvertTNRAndReplace(cell, &HFF5B, &H7B) ' Double {
Call ConvertTNRAndReplace(cell, &HFF5D, &H7D) ' Double }
Call ConvertTNRAndReplace(cell, &HFF0C, &H2C) ' Double ,
Call ConvertTNRAndReplace(cell, &HFF0E, &H2E) ' Double .
Call ConvertTNRAndReplace(cell, &HFF0F, &H2F) ' Double /
Call ConvertTNRAndReplace(cell, &H2215, &H2F) ' Double /
Call ConvertTNRAndReplace(cell, &HFF10, &H30) ' Double 0
Call ConvertTNRAndReplace(cell, &HFF11, &H31) ' Double 1
Call ConvertTNRAndReplace(cell, &HFF12, &H32) ' Double 2
Call ConvertTNRAndReplace(cell, &HFF13, &H33) ' Double 3
Call ConvertTNRAndReplace(cell, &HFF14, &H34) ' Double 4
Call ConvertTNRAndReplace(cell, &HFF15, &H35) ' Double 5
Call ConvertTNRAndReplace(cell, &HFF16, &H36) ' Double 6
Call ConvertTNRAndReplace(cell, &HFF17, &H37) ' Double 7
Call ConvertTNRAndReplace(cell, &HFF18, &H38) ' Double 8
Call ConvertTNRAndReplace(cell, &HFF19, &H39) ' Double 9
Call ConvertTNRAndReplace(cell, &HFF1B, &H3B) ' Double ;
Call ConvertTNRAndReplace(cell, &HFF3C, &H5C) ' Double rv solidus
Call ConvertTNRAndReplace(cell, &HFF3E, &H5E) ' Double ^
Call ConvertTNRAndReplace(cell, &HFF21, &H41) ' Double A
Call ConvertTNRAndReplace(cell, &HFF22, &H42) ' Double B
Call ConvertTNRAndReplace(cell, &HFF23, &H43) ' Double C
Call ConvertTNRAndReplace(cell, &HFF24, &H44) ' Double D
Call ConvertTNRAndReplace(cell, &HFF25, &H45) ' Double E
Call ConvertTNRAndReplace(cell, &HFF26, &H46) ' Double F
Call ConvertTNRAndReplace(cell, &HFF27, &H47) ' Double G
Call ConvertTNRAndReplace(cell, &HFF28, &H48) ' Double H
Call ConvertTNRAndReplace(cell, &HFF29, &H49) ' Double I
Call ConvertTNRAndReplace(cell, &HFF2A, &H4A) ' Double J
Call ConvertTNRAndReplace(cell, &HFF2B, &H4B) ' Double K
Call ConvertTNRAndReplace(cell, &HFF2C, &H4C) ' Double L
Call ConvertTNRAndReplace(cell, &HFF2D, &H4D) ' Double M
Call ConvertTNRAndReplace(cell, &HFF2E, &H4E) ' Double N
Call ConvertTNRAndReplace(cell, &HFF2F, &H4F) ' Double O
Call ConvertTNRAndReplace(cell, &HFF30, &H50) ' Double P
Call ConvertTNRAndReplace(cell, &HFF31, &H51) ' Double Q
Call ConvertTNRAndReplace(cell, &HFF32, &H52) ' Double R
Call ConvertTNRAndReplace(cell, &HFF33, &H53) ' Double S
Call ConvertTNRAndReplace(cell, &HFF34, &H54) ' Double T
Call ConvertTNRAndReplace(cell, &HFF35, &H55) ' Double U
Call ConvertTNRAndReplace(cell, &HFF36, &H56) ' Double V
Call ConvertTNRAndReplace(cell, &HFF37, &H57) ' Double W
Call ConvertTNRAndReplace(cell, &HFF38, &H58) ' Double X
Call ConvertTNRAndReplace(cell, &HFF39, &H59) ' Double Y
Call ConvertTNRAndReplace(cell, &HFF3A, &H5A) ' Double Z
Call ConvertTNRAndReplace(cell, &HFF41, &H61) ' Double a
Call ConvertTNRAndReplace(cell, &HFF42, &H62) ' Double b
Call ConvertTNRAndReplace(cell, &HFF43, &H63) ' Double c
Call ConvertTNRAndReplace(cell, &HFF44, &H64) ' Double d
Call ConvertTNRAndReplace(cell, &HFF45, &H65) ' Double e
Call ConvertTNRAndReplace(cell, &HFF46, &H66) ' Double f
Call ConvertTNRAndReplace(cell, &HFF47, &H67) ' Double g
Call ConvertTNRAndReplace(cell, &HFF48, &H68) ' Double h
Call ConvertTNRAndReplace(cell, &HFF49, &H69) ' Double i
Call ConvertTNRAndReplace(cell, &HFF4A, &H6A) ' Double j
Call ConvertTNRAndReplace(cell, &HFF4B, &H6B) ' Double k
Call ConvertTNRAndReplace(cell, &HFF4C, &H6C) ' Double l
Call ConvertTNRAndReplace(cell, &HFF4D, &H6D) ' Double m
Call ConvertTNRAndReplace(cell, &HFF4E, &H6E) ' Double n
Call ConvertTNRAndReplace(cell, &HFF4F, &H6F) ' Double o
Call ConvertTNRAndReplace(cell, &HFF50, &H70) ' Double p
Call ConvertTNRAndReplace(cell, &HFF51, &H71) ' Double q
Call ConvertTNRAndReplace(cell, &HFF52, &H72) ' Double r
Call ConvertTNRAndReplace(cell, &HFF53, &H73) ' Double s
Call ConvertTNRAndReplace(cell, &HFF54, &H74) ' Double t
Call ConvertTNRAndReplace(cell, &HFF55, &H75) ' Double u
Call ConvertTNRAndReplace(cell, &HFF56, &H76) ' Double v
Call ConvertTNRAndReplace(cell, &HFF57, &H77) ' Double w
Call ConvertTNRAndReplace(cell, &HFF58, &H78) ' Double x
Call ConvertTNRAndReplace(cell, &HFF59, &H79) ' Double y
Call ConvertTNRAndReplace(cell, &HFF5A, &H7A) ' Double z
Call ConvertCelsius(cell, &H2103, "°C") ' Double Celsius
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 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 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 ConvertTNRAndReplace(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 = "Times New Roman"
charPos = InStr(charPos + 1, thisCell.Value, ChrW(inputCharCode))
Loop
End Sub
Sub ConvertCelsius(ByRef thisCell As Variant, ByVal inputCharCode As Long, ByVal outputChar As String)
Dim charPos As Long
charPos = InStr(thisCell.Value, ChrW(inputCharCode))
Do While charPos > 0
thisCell.Characters(charPos, 1).Text = outputChar
thisCell.Characters(charPos, 1).Font.Name = "Symbol"
charPos = charPos + 1
thisCell.Characters(charPos, 1).Font.Name = "Times New Roman"
charPos = InStr(charPos + 1, thisCell.Value, ChrW(inputCharCode))
Loop
End Sub