Regular expression custom functions and examples VBA

Option Explicit


Public Function regex_replace(data As String, pattern As String, Optional replace_with_str = vbNullString, Optional isGlobal As Boolean = True, Optional isCaseSensetive As Boolean = True, Optional isMultiLine As Boolean = True) As String
'replace string data with using a regex pattern
Dim regex As Object
On Error GoTo errHandler
Set regex = CreateObject("vbScript.regExp")
With regex
    .Global = isGlobal
    .ignoreCase = isCaseSensetive
    .MultiLine = isMultiLine
    .pattern = pattern
    regex_replace = .Replace(data, replace_with_str)
End With
exitSuccess:
    Set regex = Nothing
    Exit Function
errHandler:
    Debug.Print Err.Description
    regex_replace = data
    Resume exitSuccess
End Function

Public Function regex_pattern_count(data As String, pattern As String, Optional isGlobal As Boolean = True, Optional isCaseSensetive As Boolean = True, Optional isMultiLine As Boolean = True) As Long
'Count the number of Pattern matches in a string.
'if an error occurs -1 is returned
Dim regex As Object
Dim Matches As Object

    'Set up regular expression object
On Error GoTo errHandler
    Set regex = CreateObject("vbScript.regExp")
    regex.pattern = pattern
    regex.Global = isGlobal
    regex.ignoreCase = isCaseSensetive
    regex.MultiLine = isMultiLine
    'Retrieve all matches
    Set Matches = regex.Execute(data)
    'Return the corrected count of matches
    regex_pattern_count = Matches.Count
exitSuccess:
    Set regex = Nothing
    Exit Function
errHandler:
    Debug.Print Err.Description
    regex_pattern_count = -1
    Resume exitSuccess
End Function

Public Function regex_get_matches(data As String, pattern As String, Optional isGlobal As Boolean = True, Optional isCaseSensetive As Boolean = True, Optional isMultiLine As Boolean = True) As Collection
'returns a collection of pattern matches
'if an error occurs and empty collection is returned
Dim regex As Object
Dim Matches As Object
Dim item As Object
Dim container As New Collection

    'Set up regular expression object
On Error GoTo errHandler
    Set regex = CreateObject("vbScript.regExp")
    regex.pattern = pattern
    regex.Global = isGlobal
    regex.ignoreCase = isCaseSensetive
    regex.MultiLine = isMultiLine
    'Retrieve all matches
    Set Matches = regex.Execute(data)
    'insert each match into container as string data
    For Each item In Matches
        container.Add (CStr(item))
        Debug.Print CStr(item)
    Next item
exitSuccess:
    Set regex_get_matches = container
    Set container = Nothing
    Set regex = Nothing
    Exit Function
errHandler:
    Debug.Print Err.Description
    Set regex_get_matches = New Collection
    Resume exitSuccess
End Function



Sub regex_testing()
Const data = "Today is a good day to code! 08-18-18"

'get word count
Debug.Print regex_pattern_count(data, "[a-z]+")

'display words only
Debug.Print regex_replace(data, "[^a-z\s]")

'extract date
Call regex_get_matches(data, "[0-9]+-[0-9]+-[0-9]+")

'remove date
Debug.Print regex_replace(data, "[0-9]+-[0-9]+-[0-9]+")

'get only letters numbers and spaces
Debug.Print regex_replace(data, "[^a-z\s]")

End Sub