SOLVED

Help to use TRIM or Left & RIGHT to extract TEXT

Iron Contributor

Hi, 

 

I have a list of data files, the short form code of the service provider is contained in the file name. I wish to use this to then sort and follow up by service provider. The file name lengths can differ.

 

Can someone please assist in helping extract the service provider code from the filename?

 

Thank you kindly for any assistance.

9 Replies
best response confirmed by calof1 (Iron Contributor)
Solution

@calof1 

You may try the following macro to get the service providers in column B.

Sub FindServiceProvider()
Dim lr      As Long
Dim rng     As Range
Dim cel     As Range
Dim Matches As Object

Application.ScreenUpdating = False

lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("A2:A" & lr)

With CreateObject("VBScript.RegExp")
    .Global = False
    .Pattern = "[A-Z]{3,}"
    For Each cel In rng
        If .Test(cel) Then
            Set Matches = .Execute(cel.Value)
            cel.Offset(0, 1).Value = Matches(0)
        End If
    Next cel
End With

Application.ScreenUpdating = True
End Sub

 

In the attached, click the button called "Get Service Providers" to run the code.

 

 

hi@Subodh_Tiwari_sktneer 

 

Thank you again for your assistance, very much appreciated. Works perfectly.

 

Many thanks,

You're welcome @calof1! Glad it worked as desired.

Hi@Subodh_Tiwari_sktneer 

 

I have tried replicating this to my spreadsheet. The output i wish to place the service provider is Column X, looking at the macro i believe i need to update the below section from to say 24 (new Column number).

 

cel.Offset(0, 2)

 

Given the information is still column D, i am guessing i change the below from A to D?

Set rng = Range("A2:A" & lr)

With CreateObject("VBScript.RegExp")
.Global = False
.Pattern = "[A-Z]{3,}"

 

Would i need to update anything else?

 

Many thanks,

@calof1 

I have added comments in the following code which would help you to tweak the code as per your requirement.

 

Sub FindServiceProvider()
Dim lr      As Long
Dim r       As Long
Dim rng     As Range
Dim cel     As Range
Dim Matches As Object

Application.ScreenUpdating = False

'Assuming Pcontrol Codes are in column A
'then finding the last row with data in column A
lr = Cells(Rows.Count, "A").End(xlUp).Row

'Setting the Pcontrol Codes Range in column A
Set rng = Range("A2:A" & lr)


With CreateObject("VBScript.RegExp")
    .Global = False
    .Pattern = "[A-Z]{3,}"
    For Each cel In rng
        r = cel.Row
        If .Test(cel) Then
            Set Matches = .Execute(cel.Value)
            'Placing the Service Provider in the destination cell, in this case column B
            'If you want to write the Service Provider say in Column D,
            'use Cells(r, "D").Value in the following line
            Cells(r, "B").Value = Matches(0)
        End If
    Next cel
End With

Application.ScreenUpdating = True
End Sub

Hi@Subodh_Tiwari_sktneer 

 

Thanks again for the help.

 

I have changed the references as required, however i have noticed that when i run the macro it comes with a message saying to define the variable. I am new to VBA but think it has to do with the option Explicit, do i need to add a line to say which tab it refers to?

calof1_0-1585003252488.png

 

calof1_1-1585003364009.png

 

 

This is adding to a tab called "P135 - Import Register", is there a way to define this to solve the error?

 

Thanks again for your help, and apologies for so many questions.

@calof1 

If you look at the latest tweaked code (with added comments), you missed a variable declaration and one line of code as well i.e. you partially tweaked the original code.

 

After the tweak, your final code should be like this...

Sub FindServiceProvider()
Dim lr      As Long
Dim r       As Long
Dim rng     As Range
Dim cel     As Range
Dim Matches As Object

Application.ScreenUpdating = False

lr = Cells(Rows.Count, "D").End(xlUp).Row
Set rng = Range("D2:D" & lr)

With CreateObject("VBScript.RegExp")
    .Global = False
    .Pattern = "[A-Z]{3,}"
    For Each cel In rng
        r = cel.Row
        If .Test(cel) Then
            Set Matches = .Execute(cel.Value)
            Cells(r, "X").Value = Matches(0)
        End If
    Next cel
End With

Application.ScreenUpdating = True
End Sub

 

 

 

 

Hi@Subodh_Tiwari_sktneer 

 

My apologies for missing the line of code, i have now updated.

 

Thanks again for all your assistance.

 

All the best.

1 best response

Accepted Solutions
best response confirmed by calof1 (Iron Contributor)
Solution

@calof1 

You may try the following macro to get the service providers in column B.

Sub FindServiceProvider()
Dim lr      As Long
Dim rng     As Range
Dim cel     As Range
Dim Matches As Object

Application.ScreenUpdating = False

lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("A2:A" & lr)

With CreateObject("VBScript.RegExp")
    .Global = False
    .Pattern = "[A-Z]{3,}"
    For Each cel In rng
        If .Test(cel) Then
            Set Matches = .Execute(cel.Value)
            cel.Offset(0, 1).Value = Matches(0)
        End If
    Next cel
End With

Application.ScreenUpdating = True
End Sub

 

In the attached, click the button called "Get Service Providers" to run the code.

 

 

View solution in original post