SUBSTITUTES function supporting arrays of "find" and "replace" parameters
From time to time, users need to remove multiple characters from a string. For example, you might want to remove all punctuation, or all accented characters.
Right now, you have to do that with a lengthy nested formula using the SUBSTITUTE function. Such formulas are hard to read and challenging for a novice to debug. Or you could write a VBA userdefined function that performs each of the substitutions for you.
The better approach would be a SUBSTITUTES function that works like SUBSTITUTE but accepts an array (or range of cells) for the Find parameter, and possibly also for the Replace parameter.
=SUBSTITUTES(text, OldTextArray, NewTextArray, optional InstanceNum)
If NewTextArray is a single value, then each of the values in OldTextArray would be replaced with that single value.
If NewTextArray matches OldTextArray in dimensions, then an element of OldTextArray is replaced with the corresponding element of NewTextArray.
If InstanceNum is omitted, then all matches are replaced. If InstanceNum is a positive integer, then just that instance is replaced. If InstanceNum is a negative integer, then just that instance (counting from the end of the string) is replaced. If the absolute value of InstanceNum exceeds the number of matches, then all matches are replaced.
To remove punctuation from the text, you might use:
=TRIM(SUBSTITUTES(A2, {",",".","?","!",";",":","_",""}," "))
To replace the last comma with an ampersand, you might use:
=SUBSTITUTES(A2, ", ", " & ",1)
This formula would turn "dog, horse, mouse" into "dog, horse & mouse"
5 comments

Jim Conachan commented
Excellent suggested addition Mr. Yundt.
Microsoft, please give this serious consideration.
Excel user since 2.0
VBA developer since 1994 
Jim Moncure commented
Great recommendation! Would simplify multiple string character replacement!
Jim

Brad Yundt commented
Sample VBA code implementing the suggestion shown below. A file with test cases is available (I tried to upload it, but failed).
Option Compare Text
Function Substitutes(text As String, OldText As Variant, NewText As Variant, Optional InstanceNum As Long = 0, Optional CaseSensitive As Boolean = False)
'Function works like SUBSTITUTE, except it can accept arrays for OldText and New Text, and InstanceNum may be negative _
If InstanceNum is 0, all matches to OldText elements are replaced with the corresponding element in NewText _
If NewText has only one value, then all matches to OldText elements are replaced with NewText _
If InstanceNum is a positive integer, that instance of a match (counting from beginning of string) is replaced with NewText _
If InstanceNum is a negative integer, that instance of a match (counting from the end of string) is replaced with NewTextDim i As Long, j As Long, Matches As Long, n As Long, nOldText As Long, nNewText As Long
Dim v As Variant, Texts As Variant
Dim b As Boolean, bTest As Boolean
Dim TextCompare As Integer
Dim s As String, s2 As StringIf VarType(OldText) = 8 Then
nOldText = 1
Else
For Each v In OldText
nOldText = nOldText + 1
Next
End IfIf VarType(NewText) = 8 Then
nNewText = 1
Else
For Each v In NewText
nNewText = nNewText + 1
Next
End IfIf (nNewText > 1) And (nOldText > nNewText) Then
Substitutes = CVErr(xlErrValue)
Exit Function
End IfReDim Texts(1 To nOldText, 1 To 2)
i = 0
If nOldText = 1 Then
Texts(1, 1) = OldText
Else
For Each v In OldText
i = i + 1
Texts(i, 1) = v
Next
End IfIf nNewText = 1 Then
For i = 1 To nOldText
Texts(i, 2) = NewText
Next
Else
i = 0
For Each v In NewText
i = i + 1
If i > nOldText Then Exit For
Texts(i, 2) = v
Next
End Ifn = Len(text)
s2 = text
If InstanceNum >= 0 Then
For j = 1 To n
For i = 1 To nOldText
bTest = IIf(CaseSensitive, InStr(j, s2, Texts(i, 1), vbBinaryCompare) = j, Mid(s2, j) Like (Texts(i, 1) & "*"))
If bTest Then
Matches = Matches + 1
If Matches = InstanceNum Then
b = True
If j > 1 Then s = Left(s2, j  1)
s2 = s & Texts(i, 2) & Mid(s2, j + Len(Texts(i, 1)))
Exit For
ElseIf InstanceNum = 0 Then
If j > 1 Then s = Left(s2, j  1)
s2 = s & Texts(i, 2) & Mid(s2, j + Len(Texts(i, 1)))
If Len(Texts(i, 2)) > 0 Then j = j + Len(Texts(i, 2))  1
n = n  Len(Texts(i, 1)) + Len(Texts(i, 2))
End If
End If
Next
If b = True Then Exit For
Next
Else
For j = n To 1 Step 1
For i = 1 To nOldText
bTest = IIf(CaseSensitive, InStr(j, s2, Texts(i, 1), vbBinaryCompare) = j, Mid(s2, j) Like (Texts(i, 1) & "*"))
If bTest Then
Matches = Matches  1
If Matches = InstanceNum Then
b = True
If j > 1 Then s = Left(s2, j  1)
s2 = s & Texts(i, 2) & Mid(s2, j + Len(Texts(i, 1)))
Exit For
End If
End If
Next
If b = True Then Exit For
Next
End IfSubstitutes = s2
End Function 
Jan Karel Pieterse commented
Excellent suggestion!

Brad Yundt commented
Another good feature to add to such a function would be an optional Boolean variable for case sensitive matching.
Wildcard matching ought to be part of the SUBSTITUTES function, so I added it to my sample code (but only for case insensitive matching).