Mar 19 2020 05:26 PM
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.
Mar 19 2020 09:39 PM
SolutionYou 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.
Mar 22 2020 08:11 PM
Thank you again for your assistance, very much appreciated. Works perfectly.
Many thanks,
Mar 22 2020 09:49 PM
You're welcome @calof1! Glad it worked as desired.
Mar 22 2020 10:36 PM
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,
Mar 22 2020 10:53 PM
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
Mar 23 2020 03:43 PM
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?
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.
Mar 23 2020 10:42 PM
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
Mar 24 2020 04:59 PM
My apologies for missing the line of code, i have now updated.
Thanks again for all your assistance.
All the best.
Mar 19 2020 09:39 PM
SolutionYou 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.