Forum Discussion

calof1's avatar
calof1
Iron Contributor
Mar 19, 2020
Solved

Help to use TRIM or Left & RIGHT to extract TEXT

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 lengt...
admin
BI & Data Analysis
Charting
developer
excel
Excel for web
Excel on Mac
Formulas and Functions
Macros and VBA
office 365
  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Mar 19, 2020

    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.

     

     

Subodh_Tiwari_sktneer's avatar
Subodh_Tiwari_sktneer
Silver Contributor
Mar 19, 2020

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.

 

 

calof1's avatar
calof1
Iron Contributor
Mar 22, 2020

hiSubodh_Tiwari_sktneer 

 

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

 

Many thanks,

    • calof1's avatar
      calof1
      Iron Contributor
      Mar 22, 2020

      HiSubodh_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,

      • Subodh_Tiwari_sktneer's avatar
        Subodh_Tiwari_sktneer
        Silver Contributor
        Mar 22, 2020

        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

Resources