Testing Sub:
Public Sub Testing() Dim celladdr As Range 'Set celladdr = RegExFunc("TES*") Set celladdr = Application.Run("RegEx.xlam!RegExFunc", "TES*") If Not celladdr Is Nothing Then celladdr.Select Else MsgBox "No Matches" End If End Sub
"Main Function":
Public Function RegExFunc(var) As Variant RegExSearchPattern = RegExPattern(var) Set RegExFunc = RegExSearch(RegExSearchPattern) End Function
Generate StrPattern based on User Input String:
Public Function RegExPattern(my_string) As String RegExPattern = "" '''Special Character Section''' Dim special_charArr() As String Dim special_char As String special_char = "!,@,#,$,%,^,&,*,+,/,\,;,:" special_charArr() = Split(special_char, ",") '''Special Character Section''' '''Alpha Section''' Dim regexp As Object Set regexp = CreateObject("vbscript.regexp") Dim strPattern As String strPattern = "([a-z])" With regexp .ignoreCase = True .Pattern = strPattern End With '''Alpha Section''' Dim buff() As String 'my_string = "test1*1#" ReDim buff(Len(my_string) - 1) Dim i As Variant For i = 1 To Len(my_string) buff(i - 1) = Mid$(my_string, i, 1) char = buff(i - 1) If IsNumeric(char) = True Then 'MsgBox char & " = Number" RegExPattern = RegExPattern & "([0-9])" End If For Each Key In special_charArr special = InStr(char, Key) If special = 1 Then If Key <> "*" Then 'MsgBox char & " = Special NOT *" RegExPattern = RegExPattern & "^[!@#$%^&()].*$" Else 'MsgBox char & " = *" RegExPattern = RegExPattern & "." End If End If Next If regexp.Test(char) Then 'MsgBox char & " = Alpha" RegExPattern = RegExPattern & "([a-z])" End If Next 'RegExPattern = Chr(34) & RegExPattern & Chr(34) 'MsgBox RegExPattern End Function
Find StrPattern and Return Cell Address:
Public Function RegExSearch(strPattern) As Range Dim regexp As Object Dim rcell As Range, rng As Range Dim strInput As String Set regexp = CreateObject("vbscript.regexp") Set rng = Range("A1:Z255") With regexp .Global = False .MultiLine = False .ignoreCase = True .Pattern = strPattern End With For Each rcell In rng.Cells If rcell <> "" Then If strPattern <> "" Then strInput = rcell.Value If regexp.Test(strInput) Then 'MsgBox rcell & " Matched in Cell" & rcell.Address Set RegExSearch = Range(rcell.Address) Exit Function ' Stop on FIRST Match End If End If End If Next End Function