Excel VBA + Regular Expression

Question

Good, for starters. I am a little rusty on VBA, 3+ years since I need to use it.

In short, I'm trying to extract text from a string. I use regex to extract the name and date of my department from this string.

The department will always be between: and -.

I cannot share the document due to security. But I can explain the format and hopefully we can do it.

Col A ---- Col B ---- Col C --- Col D

Date (e) - Department (e) - String - Duration

Where (e) means it was extracted from a string.

My code for retrieving is still below. Currently, it will go through all the available lines and extract the department, but it always accepts: and - with it! I can't seem to find a way to cut them off.

Any help?

, , .

": Inbound Contacts -" , " ".

Sub stringSearch()
    Dim ws As Worksheet
    Dim lastRow As Long, x As Long
    Dim matches As Variant, match As Variant
    Dim Reg_Exp As Object

    Set Reg_Exp = CreateObject("vbscript.regexp")

    Reg_Exp.Pattern = "\:\s(\w.+)\s\-"


    Set ws = Sheet2

    lastRow = ws.Range("C" & Rows.Count).End(xlUp).Row

    For x = 1 To lastRow
        Set matches = Reg_Exp.Execute(CStr(ws.Range("C" & x).Value))
        If matches.Count > 0 Then
            For Each match In matches
                ws.Range("B" & x).Value = match.Value
            Next match
        End If
    Next x
End Sub

Answer 1

1.

ws.Range("B" & x).Value = match.Value

ws.Range("B" & x).Value = match.Submatches(0)

Reg_Exp.Pattern = ":\s*(\w.*?)\s*-"

, "" " 1". . - regex.

• : - a : char
• \s* - 0+
• (\w.*?) - 1 (.Submatches(0)): char 0+ ( ) (: \w , ASCII, , char, , -, [^\s-] \w)
• \s* - 0+
• - - .

Answer 2

, , regex, :

Sub TestMe()

    Dim inputString As String
    inputString = "Planning Unit: Inbound Contacts = Tuesday, 27/03/2018"
    Debug.Print Split(Split(inputString, ":")(1), "=")(0)

End Sub

• inputString : ;
• = ;

Answer 3

Regex:

Regex: ([\s\S]+?):\s*([\s\S]+?)\s*-\s*([A-z]+)\s*,\s*([0-9]{2}\/[0-9]{2}\/[0-9]{4})\b

:

:

Sub stringSearch()
    Dim ws As Worksheet
    Dim lastRow As Long, x As Long
    Dim matches As Variant, match As Variant
    Dim Reg_Exp As Object

    Set Reg_Exp = CreateObject("vbscript.regexp")

    Reg_Exp.Pattern = "([\s\S]+?):\s*([\s\S]+?)\s*-\s*([A-z]+)\s*,\s*([0-9]{2}\/[0-9]{2}\/[0-9]{4})\b"


    Set ws = Sheet2

    lastRow = ws.Range("C" & Rows.Count).End(xlUp).Row

    For x = 1 To lastRow
        Set matches = Reg_Exp.Execute(CStr(ws.Range("C" & x).Value))
        If matches.Count > 0 Then
            For Each match In matches
                For i = 0 To match.SubMatches.Count - 1
                    Debug.Print match.SubMatches(i)
                Next i
            Next match
        End If
    Next x
End Sub

:

+-------------------+
| Planning Unit     |
| Inbound Contracts |
| Tuesday           |
| 27/03/2018        |
| Planning Unit     |
| Payments & Orders |
| Tuesday           |
| 27/03/2018        |
| Planning Unit     |
| Scheduling        |
| Tuesday           |
| 27/03/2018        |
+-------------------+

Answer 4

In this case, I would use Left / Right / Mid and InStr / InStrRev instead of RegEx.

To retrieve a department:

Dim mainStr As String
Dim deptStr As String
mainStr = "Planning Unit: Inbound Contacts - Tuesday, 27/03/2018"
deptStr = Mid(mainStr, InStr(mainStr, ":") + 2)
deptStr = Left(deptStr, InStr(deptStr, "-") - 2)

To retrieve a date:

Dim mainStr As String
Dim dateStr As String
mainStr = "Planning Unit: Inbound Contacts - Tuesday, 27/03/2018"
dateStr = Right(mainStr, Len(mainStr) - InStrRev(mainStr, " "))

Honestly, this situation is common enough that you can write some kind of "extractText" function to get the text between the delimiters. Here is the one I use.

Function extractText(str As String, leftDelim As String, rightDelim As String, _
                     Optional reverseSearch As Boolean = False) As String
'Extracts text between two delimiters in a string
'By default, searches for first instance of each delimiter in string from left to right
'To search from right to left, set reverseSearch = True
'If left delimiter = "", function returns text up to right delimiter
'If right delimiter = "", function returns text after left delimiter
'If left or right delimiter not found in string, function returns empty string

    Dim leftPos As Long
    Dim rightPos As Long
    Dim leftLen As Long
    If reverseSearch Then
        leftPos = InStrRev(str, leftDelim)
        rightPos = InStrRev(str, rightDelim)
    Else
        leftPos = InStr(str, leftDelim)
        rightPos = InStr(str, rightDelim)
    End If

    leftPos = IIf(leftDelim = "", -1, leftPos)
    rightPos = IIf(rightDelim = "", -1, rightPos)
    leftLen = Len(leftDelim)

    If leftPos > 0 Then
        If rightPos = -1 Then
            extractText = Mid(str, leftPos + leftLen)
        ElseIf rightPos > leftPos Then
            extractText = Mid(str, leftPos + leftLen, rightPos - leftPos - leftLen)
        End If
    ElseIf leftPos = -1 Then
        If rightPos > 0 Then
            extractText = Left(str, rightPos - 1)
        End If
    End If

End Function