VBA to Extract text with certain pattern from a string within a single cell

bezet · Mar 31st 2017

Dear All, I have a string contained in a single cell as below.

Quote

150/50-PG Line
28.07.2016 05:44:48 By JOHN DOE
Report number:20160311-PIPE-01
Date:10-Mar-2016 – 30-Mar-2016

WORK REQUIRED

As found Defect/Problems:
1)50-PG-103-6101X (Item No. 140)

Some random report text here
Some random report text here
Some random report text here

As found Defect/Problems:
2)100-D-105-6101X (Item No. 168)

Some random report text here
Some random report text here
Some random report text here

As found Defect/Problems:
3)150-BD-101-6101X (Item No. 174)

Some random report text here
Some random report text here
Some random report text here

As found Defect/Problems:
4)150-PG-127-6101X (Item No. 175)

Some random report text here
Some random report text here
Some random report text here

As found Defect/Problems:
5)80-PG-142-61430 (Item No. 177)

Some random report text here
Some random report text here
Some random report text here

Display More

I need a way to extract the text 50-PG-103-6101X, 100-D-105-6101X, 150-BD-101-6101X, 150-PG-127-6101X and 80-PG-142-61430 into another cell. Preferably in this format.

50-PG-103-6101X
100-D-105-6101X
150-BD-101-6101X
150-PG-127-6101X
80-PG-142-61430

I tried searching all over the net, but none of the solution can do it ( or maybe I'm using the wrong search term). Hope you guys can point me at the right direction.

bryce · Mar 31st 2017

Re: VBA to Extract text with certain pattern from a string within a single cell

Can you please post a sample that has this information? Your sample has in common that the string you want is always 1 space after ) and 1 space before (. So that you might help yourself the mid() function will be of use to extract the string you want.

bezet · Apr 3rd 2017

Re: VBA to Extract text with certain pattern from a string within a single cell

The rest of my data not necessarily as the example above. But what is consistent in the format of the text I want to extract.

###-TT-###-####T

# is a number
T is an alphabet

There is always 3 dash/hyphen within that text. For those that is familiar, that is a piping line number..

bezet · Apr 3rd 2017

Re: VBA to Extract text with certain pattern from a string within a single cell

The rest of my data not necessarily as the example above. But what is consistent in the format of the text I want to extract.

###-TT-###-####T

# is a number
T is an alphabet

There is always 3 dash/hyphen within that text. For those that is familiar, that is a piping line number..

bryce · Apr 3rd 2017

Re: VBA to Extract text with certain pattern from a string within a single cell

see if this works. FYI your sample includes strings that are not consistent with the pattern you say should exist.

Code

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 = "\d{2,3}-\D{1,2}-\d{3}-\d{4}\D{1}"
    
    ' ###-TT-###-####T  <-----This is what you say your pattern looks like
    
    ' \d{2,3} = Match any number 0-9, 2 to 3 times. You indicate that the first part of the string will have 3 numbers but your sample shows it may also have 2
    ' \D{1,2} = Match any non-number 1 to 2 times. Your sample indicates that 2 letters will follow 3 numbers but your sample indicates that there may be 1 or 2 letters
    ' \d{3} = Match any number 0-9, 2 to 3 times. Didn't see any variation in your claimed pattern and sample
    ' \d{4}\D{1} = Match 4 numbers and 1 non-number. This is the last part of your pattern. However, your sample includes one instance that does not follow your stated pattern
    
        
    Set ws = Sheet1
    
    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    
    For x = 1 To lastRow
        Set matches = Reg_Exp.Execute(CStr(ws.Range("A" & 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

Display More

bezet · Apr 4th 2017

Re: VBA to Extract text with certain pattern from a string within a single cell

Quote from bryce;789634

see if this works. FYI your sample includes strings that are not consistent with the pattern you say should exist.

Code

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 = "\d{2,3}-\D{1,2}-\d{3}-\d{4}\D{1}"
    
    ' ###-TT-###-####T  <-----This is what you say your pattern looks like
    
    ' \d{2,3} = Match any number 0-9, 2 to 3 times. You indicate that the first part of the string will have 3 numbers but your sample shows it may also have 2
    ' \D{1,2} = Match any non-number 1 to 2 times. Your sample indicates that 2 letters will follow 3 numbers but your sample indicates that there may be 1 or 2 letters
    ' \d{3} = Match any number 0-9, 2 to 3 times. Didn't see any variation in your claimed pattern and sample
    ' \d{4}\D{1} = Match 4 numbers and 1 non-number. This is the last part of your pattern. However, your sample includes one instance that does not follow your stated pattern
    
        
    Set ws = Sheet1
    
    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    
    For x = 1 To lastRow
        Set matches = Reg_Exp.Execute(CStr(ws.Range("A" & 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

Display More

Hi Bryce,

Thanks for the feedback.

You are right on the pattern, they are not consistent as per my explanation. My intention was to get a solution for ###-TT-###-####T then try my hand in changing it to fit the rest of the pattern.

I will give the code a try and let you know how it goes with the real samples.

Update:
I think my explanation was a bit vague, the entire text actually contained in a single cell which mean we need to manipulate the data on string level (e.g The entire quoted text is in cell A1) , one of the reason why I was stuck since I'm not familiar with string manipulation.. Your example consider each line is kept in an individual cell. Should looks like this, as shown in the photo below. (I tried attaching file but seem I have issue with the forum attachment system)

[Blocked Image: https://pictr.com/images/2017/04/04/96a72a9978c5e963a26240d5ae4496f1.jpg]

bryce · Apr 4th 2017

Re: VBA to Extract text with certain pattern from a string within a single cell

Ok, please post an excel file so I can see how it looks and give you a better solution. That pic looks like there are carriage returns to produce that spacing. Initially I thought the data was in cells and placed the part # in the adjacent cell but if there is only one long string where do you want the part numbers? If you already have that in mind please include that in the sample. Again if you do so, I can give you a better solution.

bezet · Apr 4th 2017

Re: VBA to Extract text with certain pattern from a string within a single cell

Give me a moment, I prepare a better example and try to get it uploaded somewhere, I have issue uploading to ozgrid .

bryce · Apr 4th 2017

Re: VBA to Extract text with certain pattern from a string within a single cell

Great. About the upload. When you are replaying back, click "Go Advanced" in the bottom right. Scroll to about the middle of the page that pops up and choose "Manage Attachments." Another smaller window will appear, click "Add Files" From here navigate to your file and double click or click Open. Shen click thge button to "Upload File. At this point you are done. Just choose the "Done" botton and your file will be included in the post.

bezet · Apr 4th 2017

Re: VBA to Extract text with certain pattern from a string within a single cell

It seem I have this jumble up mess instead.
[Blocked Image: https://pictr.com/images/2017/04/04/03f372fe492ca39afaabf7ac993fe714.png]

Not sure why, I tried IE , also face the same issue. Maybe its due to my office connectivity.

bezet · Apr 4th 2017

Re: VBA to Extract text with certain pattern from a string within a single cell

Anyhow, hope you can get the sample file from this link. https://drive.google.com/open?…dXdJjrqJ8PMElQelBYdi1nVzA

The Data is in Sheet 1.
The example how I want the end result is in sheet> End result example.

Hope that is adequate.

bryce · Apr 4th 2017

Re: VBA to Extract text with certain pattern from a string within a single cell

here you go. I changed the pattern a little. Instead of looking for 4 numbers and 1 character at the end of the part number I simply look for 5 numbers or letters. There is also no need to remove the item No. xxx or the numerical listing in front of the part number. This returns only the part number

Code

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")
    
    With Reg_Exp
        .Pattern = "\d{2,3}-\D{1,2}-\d{3}-\w{5}"
        .Global = True
    End With
    
    ' ###-TT-###-####T  <-----This is what you say your pattern looks like
    
    ' \d{2,3} = Match any number 0-9, 2 to 3 times. You indicate that the first part of the string will have 3 numbers but your sample shows it may also have 2
    ' \D{1,2} = Match any non-number 1 to 2 times. Your sample indicates that 2 letters will follow 3 numbers but your sample indicates that there may be 1 or 2 letters
    ' \d{3} = Match any number 0-9, 2 to 3 times. Didn't see any variation in your claimed pattern and sample
    ' \w{5} = Match 5 numbers or non-numbers. This is the last part of your pattern. This accomodates either 5 numbers, letters oir a combination. As long as the last section of the part number is 5 characters long this will work
        
    Set ws = Sheet1
    
    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    
    For x = 1 To lastRow
        Set matches = Reg_Exp.Execute(CStr(ws.Range("A" & x).Value))
        If matches.Count > 0 Then
            For Each match In matches
                ws.Range("B" & ws.Range("B" & Rows.Count).End(xlUp).Offset(1).Row).Value = match.Value
            Next match
        End If
    Next x
End Sub

Display More

bezet · Apr 5th 2017

Re: VBA to Extract text with certain pattern from a string within a single cell

Quote from bryce;789740

here you go. I changed the pattern a little. Instead of looking for 4 numbers and 1 character at the end of the part number I simply look for 5 numbers or letters. There is also no need to remove the item No. xxx or the numerical listing in front of the part number. This returns only the part number

Code

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")
    
    With Reg_Exp
        .Pattern = "\d{2,3}-\D{1,2}-\d{3}-\w{5}"
        .Global = True
    End With
    
    ' ###-TT-###-####T  <-----This is what you say your pattern looks like
    
    ' \d{2,3} = Match any number 0-9, 2 to 3 times. You indicate that the first part of the string will have 3 numbers but your sample shows it may also have 2
    ' \D{1,2} = Match any non-number 1 to 2 times. Your sample indicates that 2 letters will follow 3 numbers but your sample indicates that there may be 1 or 2 letters
    ' \d{3} = Match any number 0-9, 2 to 3 times. Didn't see any variation in your claimed pattern and sample
    ' \w{5} = Match 5 numbers or non-numbers. This is the last part of your pattern. This accomodates either 5 numbers, letters oir a combination. As long as the last section of the part number is 5 characters long this will work
        
    Set ws = Sheet1
    
    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    
    For x = 1 To lastRow
        Set matches = Reg_Exp.Execute(CStr(ws.Range("A" & x).Value))
        If matches.Count > 0 Then
            For Each match In matches
                ws.Range("B" & ws.Range("B" & Rows.Count).End(xlUp).Offset(1).Row).Value = match.Value
            Next match
        End If
    Next x
End Sub

Display More

Dude. This is impressive!The amount of code is way less than I have in mind when I plan to do it before. Thanks!

VBA to Extract text with certain pattern from a string within a single cell

Participate now!

Share