VBA Split String Using RegEx

hotseetotsee

New Member
Joined
Dec 20, 2016
Messages
7
I am trying to write a code that recognize words and numbers from the string in the cell and splitting it using commas. I have a code that is not yet completed because I did not know how to proceed from there.

My table is similar to the table below:
ABH
IDTask DescPredecessors
1Cook Curry
2Buy Groceries1FS

<tbody>
</tbody>

As for now, I just want to split the Predecessors to recognize the Task ID (which is 1 in the IFS) and the predecessors type (which is FS in the 1FS).

The code that I came up with looked like below:
Code:
Sub SplitPredecessors()



    Dim regEx As New RegExp
    Dim strPattern As String
    Dim strInput As String
    Dim Myrange As Range
    
    Set Myrange = ActiveSheet.Range("$H$6")
    
    For Each c In Myrange
        strPattern = "([0-9]+(\.[0-9][0-9]?)?{3})([a-zA-Z]{2})"
        '([0-9]+(\.[0-9][0-9]?)?{3})([a-zA-Z]{2}) 0-9 recognize number at max 3 digit long
        'a-zA-Z recognize letter at max 2 alphabet long
        
        With regEx
                .Global = True
                .MultiLine = True
                .IgnoreCase = False
                .Pattern = strPattern
        End With
        
        If strPattern <> "" Then
            strInput = c.Value
            strReplace = "$1"
        Else
            strInput = c.Value
            strReplace = "$2"
        End If
        
        Next
                              
End Sub

If any of you know how to do this, please help. I am new to VBA. Much thanks.
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

pgc01

MrExcel MVP
Joined
Apr 25, 2006
Messages
19,884
As for now, I just want to split the Predecessors to recognize the Task ID (which is 1 in the IFS) and the predecessors type (which is FS in the 1FS).


Code:
        '([0-9]+(\.[0-9][0-9]?)?{3})([a-zA-Z]{2}) 0-9 recognize number at max 3 digit long
        'a-zA-Z recognize letter at max 2 alphabet long

Hi

So if I understand correctly the Predessessors field will have a code that is 1-3 digits (the Task ID) followed by 1-2 letters (the predecessors type). Is this correct?

If that's the case this is an example that will split the code and display the 2 parts:

Code:
Sub SplitPredecessors()
    Dim regex As RegExp, regexMatches As MatchCollection
    Dim r As Range
    Dim strInput As String
    
    Set regex = New RegExp
    Set r = ActiveSheet.Range("H6")
    
    strInput = r.Value
    With regex
        .Pattern = "^(\d{1,3})([a-zA-Z]{1,2})$"

        Set regexMatches = .Execute(strInput)
        If regexMatches.Count = 1 Then
            With regexMatches(0)
                MsgBox "Predecessor Task ID: " & .SubMatches(0) & ", Type: " & .SubMatches(1)
            End With
        Else
            MsgBox "Invalid value"
        End If
    End With
End Sub
 

hotseetotsee

New Member
Joined
Dec 20, 2016
Messages
7
Hi

So if I understand correctly the Predessessors field will have a code that is 1-3 digits (the Task ID) followed by 1-2 letters (the predecessors type). Is this correct?

If that's the case this is an example that will split the code and display the 2 parts:

Code:
Sub SplitPredecessors()
    Dim regex As RegExp, regexMatches As MatchCollection
    Dim r As Range
    Dim strInput As String
    
    Set regex = New RegExp
    Set r = ActiveSheet.Range("H6")
    
    strInput = r.Value
    With regex
        .Pattern = "^(\d{1,3})([a-zA-Z]{1,2})$"

        Set regexMatches = .Execute(strInput)
        If regexMatches.Count = 1 Then
            With regexMatches(0)
                MsgBox "Predecessor Task ID: " & .SubMatches(0) & ", Type: " & .SubMatches(1)
            End With
        Else
            MsgBox "Invalid value"
        End If
    End With
End Sub

Is this code applied to detect decimal number such as 1.1, 1.2, etc?

How do I make this code to run each time the H column was filled with the predecessors? I have tried to integrate it with the worksheet_change event that I currently have within my VBA, but then both of the function included are not functioning.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)'To generate the end date from the duration and start date


    Dim c As Range
    Dim o As Integer
    
    Application.EnableEvents = False
    'Don't do anything unless something changed in columns C or D
    
    If Not Intersect(Target, Columns("C:D")) Is Nothing Then
        'Process all changed cells in columns C and D
        For Each c In Intersect(Target, Columns("C:D"))
            With c
                'Ensure that we are on row 6 or later, and
                'column E is empty, and
                'neither column C or column D is empty
                If .Row > 5 And _
                   IsEmpty(Cells(.Row, "E").Value) And _
                   Not (IsEmpty(Cells(.Row, "C").Value) Or IsEmpty(Cells(.Row, "D").Value)) Then
                    'Ensure that column C contains a date, and
                    'column D contains a numeric value
                    If IsDate(Cells(.Row, "C").Value) And _
                       IsNumeric(Cells(.Row, "D").Value) Then
                        'Calculate planned end date
                        Cells(.Row, "E").Value = CDate(Cells(.Row, "C").Value + Cells(.Row, "D").Value)
                    End If
                End If
            End With
        Next
    End If
    
    Application.EnableEvents = True
    
	
    Dim regex As RegExp, regexMatches As MatchCollection
    Dim r As Range
    Dim strInput As String
   
    Application.EnableEvents = False
    'Don't do anything unless something changed in columns H
    Set regex = New RegExp
    If Not Intersect(Target, Columns("H")) Is Nothing Then
        
        For Each c In Intersect(Target, Columns("H"))
            With c
                'Ensure that we are on row 6 or later
                If .Row > 5 And _
                   Cells(.Row, "H").Value Then
                    'Ensure that column H contains a value
                    
                    strInput = r.Value
                        With regex
                            .Pattern = "^(\d{1,3})([a-zA-Z]{1,2})$"


                        Set regexMatches = .Execute(strInput)
                            If regexMatches.Count = 1 Then
                                With regexMatches(0)
                                    MsgBox "Predecessor Task ID: " & .SubMatches(0) & ", Type: " & .SubMatches(1)
                                End With
                            
                                Else
                                    MsgBox "Invalid value"
                            End If
                        End With
                End If
            End With
        Next
    End If
    Application.EnableEvents = True
End Sub

I don't know whether my code above is valid or not as I said before, I am new VBA.
If you do know, please help me and I am sorry for the inconveniences caused.
Much thanks.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,563
Messages
5,637,076
Members
416,956
Latest member
mitzhaki

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top