Extract words before brackets based on number of characters within closed brackets

[satish78]

Hi Friends,

I looked some posts over here on how to extract words before closed backets and based on number of characters/letters within closed brackets.
I am looking to do this with formula/vba/udf.
Here is an example

Designed and developed the application using Java Server Faces (JSF) framework and spring web flow	(JSF)	Java Server Faces
Experience in all phases of software development life cycle (SDLC), which includes User Interaction, Business Analysis/Modeling, Design/Architecture, Development, Implementation, Integration, Documentation, Testing, and Deployment	(SDLC)	software development life cycle
Extensive experience in Integrated Development Environment (IDE) such as Eclipse, NetBeans, WSAD, SpringSource tool suite and IntelliJ	(IDE)	Integrated Development Environment
Implemented Hibernate Object-Relational Mapping (ORM) for mapping between the Java classes and Database table.	(ORM)	Object-Relational Mapping
Solid design skills in Java Design Patterns, Unified Modeling Language (UML) and Object Modeling Technique (OMT)	(UML) (OMT)	Unified Modeling Language	Object Modeling Technique

 

[lrobbo314]

In the example you just posted there a a bunch of lines that do not have a text string like (JSF), line 12 for example. That's what I was talking about. The code is going line by line and if a line doesn't match, that's when you get the error.

This should help. As for the 'subscript out of range', I would need to know what line of code it's erroring out on as well as what line of the sheet it's reading.

Sub RXX()
On Error GoTo ERH:
Dim r As Range:             Set r = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:        AR = r.Value2
Dim AL As Object:           Set AL = CreateObject("System.Collections.ArrayList")
Dim MX As String
Dim SX As String
Dim SP() As String
Dim POS As Integer

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(\([A-Z]+\)),?"
    For i = 1 To UBound(AR)
        SP = Split(AR(i, 1), " ")
        Set matches = .Execute(AR(i, 1))
        For Each m In matches
            MX = MX & m.submatches(0) & " "
            POS = Application.Match(m.Value, SP, 0)
            For j = POS - Len(m.submatches(0)) + 1 To POS - 2
                SX = SX & SP(j)
                If j < POS - 2 Then SX = SX & " "
            Next j
            SX = SX & ";"
        Next m
        AL.Add Trim(MX) & ";" & SX
        MX = vbNullString
        SX = vbNullString
    Next i
End With

With r.Offset(, 1)
    .Value = Application.Transpose(AL.toArray)
    .TextToColumns DataType:=xlDelimited, SemiColon:=True
End With
Exit Sub

ERH:
If Err.Number = 13 Then
    Resume Next
Else
    MsgBox "Error #" & Err.Number & vbLf & Err.Description, vbCritical, "ERROR"
End If
End Sub

 

[satish78]

In the example you just posted there a a bunch of lines that do not have a text string like (JSF), line 12 for example. That's what I was talking about. The code is going line by line and if a line doesn't match, that's when you get the error.

This should help. As for the 'subscript out of range', I would need to know what line of code it's erroring out on as well as what line of the sheet it's reading.

Sub RXX()
On Error GoTo ERH:
Dim r As Range:             Set r = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:        AR = r.Value2
Dim AL As Object:           Set AL = CreateObject("System.Collections.ArrayList")
Dim MX As String
Dim SX As String
Dim SP() As String
Dim POS As Integer

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(\([A-Z]+\)),?"
    For i = 1 To UBound(AR)
        SP = Split(AR(i, 1), " ")
        Set matches = .Execute(AR(i, 1))
        For Each m In matches
            MX = MX & m.submatches(0) & " "
            POS = Application.Match(m.Value, SP, 0)
            For j = POS - Len(m.submatches(0)) + 1 To POS - 2
                SX = SX & SP(j)
                If j < POS - 2 Then SX = SX & " "
            Next j
            SX = SX & ";"
        Next m
        AL.Add Trim(MX) & ";" & SX
        MX = vbNullString
        SX = vbNullString
    Next i
End With

With r.Offset(, 1)
    .Value = Application.Transpose(AL.toArray)
    .TextToColumns DataType:=xlDelimited, SemiColon:=True
End With
Exit Sub

ERH:
If Err.Number = 13 Then
    Resume Next
Else
    MsgBox "Error #" & Err.Number & vbLf & Err.Description, vbCritical, "ERROR"
End If
End Sub

Still getting subscript out of range 9 and 13

 

[satish78]

In the example you just posted there a a bunch of lines that do not have a text string like (JSF), line 12 for example. That's what I was talking about. The code is going line by line and if a line doesn't match, that's when you get the error.

This should help. As for the 'subscript out of range', I would need to know what line of code it's erroring out on as well as what line of the sheet it's reading.

Sub RXX()
On Error GoTo ERH:
Dim r As Range:             Set r = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:        AR = r.Value2
Dim AL As Object:           Set AL = CreateObject("System.Collections.ArrayList")
Dim MX As String
Dim SX As String
Dim SP() As String
Dim POS As Integer

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(\([A-Z]+\)),?"
    For i = 1 To UBound(AR)
        SP = Split(AR(i, 1), " ")
        Set matches = .Execute(AR(i, 1))
        For Each m In matches
            MX = MX & m.submatches(0) & " "
            POS = Application.Match(m.Value, SP, 0)
            For j = POS - Len(m.submatches(0)) + 1 To POS - 2
                SX = SX & SP(j)
                If j < POS - 2 Then SX = SX & " "
            Next j
            SX = SX & ";"
        Next m
        AL.Add Trim(MX) & ";" & SX
        MX = vbNullString
        SX = vbNullString
    Next i
End With

With r.Offset(, 1)
    .Value = Application.Transpose(AL.toArray)
    .TextToColumns DataType:=xlDelimited, SemiColon:=True
End With
Exit Sub

ERH:
If Err.Number = 13 Then
    Resume Next
Else
    MsgBox "Error #" & Err.Number & vbLf & Err.Description, vbCritical, "ERROR"
End If
End Sub

Here is the file which you can download to test it on.

Hightail Spaces

Hightail Spaces lets you send unlimited files, of any size, to anyone. Collaborate with your team and evolve your work.

spaces.hightail.com