23

I'm using VBA to read some titles and then copy that information to a PowerPoint presentation.

The 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, for example 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.

How can I do this?

double-beep
  • 5,031
  • 17
  • 33
  • 41
pixie
  • 283
  • 2
  • 3
  • 10

4 Answers4

49

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
David Zemens
  • 53,033
  • 11
  • 81
  • 130
  • Great post. But it does not work for the character ? – WJA Mar 28 '17 at 11:56
  • 2
    @JohnAndrews yes it will if you modify the `SpecialCharacters` string so that the question mark is part of it: `Const SpecialCharacters As String = "!,@,#,$,%,^,&,*,(,),{,[,],},?"`. – David Zemens Mar 28 '17 at 13:47
  • 1
    The only character I would argue is missing from the list is the comma itself! But I know that it would take some extra tinkering to adjust for that char – Marcucciboy2 Aug 29 '19 at 21:13
  • 2
    To also remove commas, replace first line with `Const SpecialCharacters As String = "! @ # $ % ^ & * ( ) { [ ] } ? ,"` and in the for statement `For each char in Split(SpecialCharacters, " ")`. You can replace the spaces by any other character in both statements, for example `_`. – Friedrich May 06 '20 at 09:52
  • any tip to replace spaces with "_"? I have added a space in the list of characters and for some reason it does not work – Alexis.Rolland Jan 09 '22 at 12:12
  • This function replaces each item in the delimited list with a space (`" "`). Please review documentation for the string `Replace` method and you could update as needed; but you'll need some if/then or other conditional block to handle the space replacement, since, by original design, this function replaces ANY specified character with a space, if currently implemented you will end up replacing space with space :) – David Zemens Jan 11 '22 at 17:49
18

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.

V. Brunelle
  • 1,038
  • 11
  • 29
  • This is much faster than regex if the number of character in a cell is small. For cell have 20 chars, about 15 times faster. At about 2000 chars, they are about the same, for higher, regex is faster. – Tam Le Mar 22 '20 at 09:36
10

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)
GuruKay
  • 3,429
  • 2
  • 20
  • 8
  • 3
    Does not work on OSX. See: https://stackoverflow.com/questions/43738332/activex-component-can-t-create-object-excel-for-mac – mbunch Jun 12 '19 at 16:04
2

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
Ferroao
  • 3,042
  • 28
  • 53