Page tree

Welcome to FreeSoftwareServers Confluence Wiki

Skip to end of metadata
Go to start of metadata

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
  • No labels