Removing special characters VBA Excel
I'm using VBA to read some TITLES and then copy that information to a powerpoint presentation.
My Problem is, that the TITLES have special characters, but Image files that I am also coping over do not.
The TITLE forms part of a path to load a JPEG into a picture container. E.g. "P k.jpg", but the title is called "p.k".
I want to be able to ignore the special characters in the TITLE and just get it to see a space instead so it picks up the right JPG file.
Is that possible?
Thank you!
What do you consider "special" characters, just simple punctuation? You should be able to use the Replace
function: Replace("p.k","."," ")
.
Sub Test()
Dim myString as String
Dim newString as String
myString = "p.k"
newString = replace(myString, ".", " ")
MsgBox newString
End Sub
If you have several characters, you can do this in a custom function or a simple chained series of Replace
functions, etc.
Sub Test()
Dim myString as String
Dim newString as String
myString = "!p.k"
newString = Replace(Replace(myString, ".", " "), "!", " ")
'## OR, if it is easier for you to interpret, you can do two sequential statements:
'newString = replace(myString, ".", " ")
'newString = replace(newString, "!", " ")
MsgBox newString
End Sub
If you have a lot of potential special characters (non-English accented ascii for example?) you can do a custom function or iteration over an array.
Const SpecialCharacters As String = "!,@,#,$,%,^,&,*,(,),{,[,],},?" 'modify as needed
Sub test()
Dim myString as String
Dim newString as String
Dim char as Variant
myString = "!p#*@)k{kdfhouef3829J"
newString = myString
For each char in Split(SpecialCharacters, ",")
newString = Replace(newString, char, " ")
Next
End Sub
In the case that you not only want to exclude a list of special characters, but to exclude all characters that are not letters or numbers, I would suggest that you use a char type comparison approach.
For each character in the String, I would check if the unicode character is between "A" and "Z", between "a" and "z" or between "0" and "9". This is the vba code:
Function cleanString(text As String) As String
Dim output As String
Dim c 'since char type does not exist in vba, we have to use variant type.
For i = 1 To Len(text)
c = Mid(text, i, 1) 'Select the character at the i position
If (c >= "a" And c <= "z") Or (c >= "0" And c <= "9") Or (c >= "A" And c <= "Z") Then
output = output & c 'add the character to your output.
Else
output = output & " " 'add the replacement character (space) to your output
End If
Next
cleanString = output
End Function
The Wikipedia list of Unicode characers is a good quick-start if you want to customize this function a little more.
This solution has the advantage to be functionnal even if the user finds a way to introduce new special characters. It also faster than comparing two lists together.
Here is how removed special characters.
I simply applied regex
Dim strPattern As String: strPattern = "[^a-zA-Z0-9]" 'The regex pattern to find special characters
Dim strReplace As String: strReplace = "" 'The replacement for the special characters
Set regEx = CreateObject("vbscript.regexp") 'Initialize the regex object
Dim GCID As String: GCID = "Text #N/A" 'The text to be stripped of special characters
' Configure the regex object
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
' Perform the regex replacement
GCID = regEx.Replace(GCID, strReplace)
This is what I use, based on this link
Function StripAccentb(RA As Range)
Dim A As String * 1
Dim B As String * 1
Dim i As Integer
Dim S As String
'Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
'Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
Const AccChars = "ñéúãíçóêôöá" ' using less characters is faster
Const RegChars = "neuaicoeooa"
S = RA.Cells.Text
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, i, 1)
S = Replace(S, A, B)
'Debug.Print (S)
Next
StripAccentb = S
Exit Function
End Function
Usage:
=StripAccentb(B2) ' cell address
Sub version for all cells in a sheet:
Sub replacesub()
Dim A As String * 1
Dim B As String * 1
Dim i As Integer
Dim S As String
Const AccChars = "ñéúãíçóêôöá" ' using less characters is faster
Const RegChars = "neuaicoeooa"
Range("A1").Resize(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select '
For Each cell In Selection
If cell <> "" Then
S = cell.Text
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, i, 1)
S = replace(S, A, B)
Next
cell.Value = S
Debug.Print "celltext "; (cell.Text)
End If
Next cell
End Sub