Ship To Name: Replace(Replace(Replace(Replace([SHIP TO Name]," "," ")," "," ")," "," ")," "," ")
SELECT
FieldX,
InnerTrim(FieldX) AS X1,
RegexReplace(FieldX, " {2,}", " ") AS X2
FROM
TableY' in a standard module
Private pRegEx As Object
Public Property Get oRegEx() As Object
If (pRegEx Is Nothing) Then Set pRegEx = CreateObject("Vbscript.Regexp")
Set oRegEx = pRegEx
End Property
Public Function RegExReplace(ByVal SourceText As String, _
ByVal SearchPattern As String, _
ByVal ReplaceText As String, _
Optional ByVal bIgnoreCase As Boolean = True, _
Optional ByVal bGlobal As Boolean = True, _
Optional ByVal bMultiLine As Boolean = True) As String
With oRegEx
.Pattern = SearchPattern
.IgnoreCase = bIgnoreCase
.Global = bGlobal
.Multiline = bMultiLine
RegExReplace = .Replace(SourceText, ReplaceText)
End With
End Function
Public Function InnerTrim(ByVal ThisString As String) As String
Dim sResult As String
sResult = ThisString
Do While InStr(1, sResult, " ") > 0
sResult = Replace(sResult, " ", " ")
Loop
InnerTrim = sResult
End Function
Public Function ReplaceMultiSpace(strIn As String) As String
Dim old As String
Dim newout As String
old = Trim(strIn)
newout = old
Do
old = newout
newout = Replace(old, " ", " ")
Loop Until old = newout
ReplaceMultiSpace = newout
End Function
another function:
Public Function SngSpaceOnly(Byval value As Variant)
If IsNull(value) then
SngSpaceOnly = value
Exit Function
End If
Do While Instr(1, value, " ") <> 0
value = Replace$(value, " ", " ")
Loop
SngSpaceOnly=value
End Function
Left(value, Instr(value, " ") - 1 & Mid(value, InstrRev(value, " ") + 2)you should test it to see the result.
OK multiple cases is a different kettle of fish and more complex but I still would not do it with a loop.
Colin (isladogs) did some speed comparisons on Regex a while back and the performance was surprisingly poor.
However, one should avoid the mistake of creating the RegEx object in a function each time, instead one would use a persistent object. I like using RegEx-using functions, also in queries (so suitable for the masses). With the persistent object, there was an acceleration by a factor of about 11 in own comparisons in specific queries.
www.isladogs.co.uk
Option Compare Database
Option Explicit
' in a standard module
Private pRegEx As Object
Public Property Get oRegEx() As Object
If (pRegEx Is Nothing) Then Set pRegEx = CreateObject("Vbscript.Regexp")
Set oRegEx = pRegEx
End Property
Public Function RegExReplace(ByVal SourceText As String, _
ByVal SearchPattern As String, _
ByVal ReplaceText As String, _
Optional ByVal bIgnoreCase As Boolean = True, _
Optional ByVal bGlobal As Boolean = True, _
Optional ByVal bMultiLine As Boolean = True) As String
With oRegEx
.Pattern = SearchPattern
.IgnoreCase = bIgnoreCase
.Global = bGlobal
.Multiline = bMultiLine
RegExReplace = .Replace(SourceText, ReplaceText)
End With
End Function
Public Function InnerTrim(ByVal ThisString As String) As String
Dim sResult As String
sResult = ThisString
Do While InStr(1, sResult, " ") > 0
sResult = Replace(sResult, " ", " ")
Loop
InnerTrim = sResult
End Function
Public Function ReplaceMultiSpace(strIN As String) As String
Dim old As String
Dim newout As String
old = Trim(strIN)
newout = old
Do
old = newout
newout = Replace(old, " ", " ")
Loop Until old = newout
ReplaceMultiSpace = newout
End Function
Public Function SngSpaceOnly(ByVal value As Variant)
If IsNull(value) Then
SngSpaceOnly = value
Exit Function
End If
Do While InStr(1, value, " ") <> 0
value = Replace$(value, " ", " ")
Loop
SngSpaceOnly = value
End Function
Function SpeedTest(strIN As String)
Dim strOUT As String, dblStart As Double, dblEnd As Double
Dim lngCount As Long
dblStart = Timer
For lngCount = 1 To 10000
strOUT = ReplaceMultiSpace(strIN)
Next
dblEnd = Timer
Debug.Print "1. ReplaceMultiSpace" & " : Time Taken = " & dblEnd - dblStart & " s"
dblStart = Timer
For lngCount = 1 To 10000
strOUT = SngSpaceOnly(strIN)
Next
dblEnd = Timer
Debug.Print "2. SngSpaceOnly" & " : Time Taken = " & dblEnd - dblStart & " s"
dblStart = Timer
For lngCount = 1 To 10000
strOUT = RegExReplace(strIN, " {2,}", " ")
Next
dblEnd = Timer
Debug.Print "3. RegExReplace" & " : Time Taken = " & dblEnd - dblStart & " s"
End FunctionSub Test1()
Dim strIN As String
strIN = "abc def ghi xyz"
Debug.Print "Test1 - Short String" & vbCrLf & "===================="
SpeedTest (strIN)
Debug.Print "" & vbCrLf
End SubTest1 - Short String
====================
1. ReplaceMultiSpace : Time Taken = 0.0703125 s
2. SngSpaceOnly : Time Taken = 0.0703125 s
3. RegExReplace : Time Taken = 0.0859375 sSub Test2()
Dim strIN As String
strIN = "Regular expressions are a very powerful tool for developers to make use of ." & _
"However, in this particular set of tests, using RegEx was clearly disadvantageous." & _
"Perhaps its use was overkill for the test done?" & _
" " & _
"In other cases, Regex may provide the best or only method of obtaining results." & _
" " & _
"I would be grateful for any feedback on this article" & _
"I would also welcome any suggestions for other tests in order to further assess the comparative" & _
" strength of regular expressions against other methods."
Debug.Print "Test2 - Longer String" & vbCrLf & "======================"
SpeedTest (strIN)
Debug.Print "" & vbCrLf
End SubTest2 - Longer String
======================
1. ReplaceMultiSpace : Time Taken = 0.4765625 s
2. SngSpaceOnly : Time Taken = 0.58203125 s
3. RegExReplace : Time Taken = 0.16015625 sPublic Function OneSpaceOnly(ByVal var As Variant)
Static oReg As Object
Dim s As String
On Error GoTo create_object
If IsNull(var) Then Exit Function
s = var
With oReg
.Pattern = " {2,}"
.Global = True
s = .Replace(s, " ")
End With
OneSpaceOnly = s
Exit Function
create_object:
Set oReg = CreateObject("vbscript.regexp")
Resume Next
End Function
