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 Function
