CODEWITHSUNDEEP
excelvba
user3782816
user3782816

Reputation: 171

How to extract text from between brackets?

I wrote VBA code that opens all of the .xls files in a folder, and copies and pastes desired information out of those files into a new workbook.

Each row in the new workbook is associated with a file from the folder.

Column1, Column2, Column3  
FileName1, ABC, XYZ  
FileName2, DEF, TUV

The info in Column3 has the formatting of

ArbitraryString1(Very_Important_Info)ArbitraryString2

Because I wanted Column3 to look nice, I iterated over every row and used 

Range("C"&X).TextToColumns DataType:=xlDelimited, Other:=True _
OtherChar:="("
Columns("E:E").Insert Shift:=xlToRight *
Range("D"&X).TextToColumn DataType:=xlDelimited, Other:=True _
OtherChar:=")"
Range("C"&X).TextToColumns DataType:=xlDelimited, Other:=True _
OtherChar:="(" **
Columns("E:Z").Delete
Columns("C:C").Delete

*This is needed so when I call TextToColumn the second time I do not get a message asking if I want to overwrite what is already in that column.

I end up with 

Column1, Column2, Column3
FileName1, ABC, Very_Important_Info_1
FileName2, DEF, Very_Important_Info_2

After calling OtherChar:="(" the first time I end up seeing

(Very_Important_Info)ArbitraryString2

with the left bracket still attached.

I call the method a second time or ColumnC would look like

(Very_Important_Info

Upvotes: 0

Views: 194

Answers (2)

TinMan
TinMan

Reputation: 7759

Here is a simplified version of Michal Rosa's code:

Sub BeautifyIt()
    With Worksheets("Sheet1")
        With .Range("C2", .Range("C" & .Rows.Count).End(xlUp))
            .Replace ")", "("
            .TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, _
                           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                           Semicolon:=False, Comma:=False, Space:=False, Other:=True, _
                           OtherChar:="(", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        End With
    End With
End Sub

Upvotes: 0

Michal
Michal

Reputation: 5882

Might work better with SPLIT

Sub TextToCols()
    Dim rng As Range
    Dim r As Range
    Dim l As Long
    Dim arr As Variant

    With ActiveSheet
        l = .Cells(.Rows.Count, "C").End(xlUp).Row

        Set rng = Range("C2:C" & l)
        For Each r In rng
            r.Value = Application.WorksheetFunction.Substitute(r.Value, ")", "(")
            arr = Split(r.Value, "(")
            Cells(r.Row, 3).Value = arr(1)
        Next r

    End With
End Sub

Or text-to-columns:

Sub TextToCols()
    Dim rng As Range
    Dim r As Range
    Dim l As Long

    With ActiveSheet
        l = .Cells(.Rows.Count, "C").End(xlUp).Row

        Set rng = Range("C2:C" & l)
        For Each r In rng
            r.Value = Application.WorksheetFunction.Substitute(r.Value, ")", "(")
        Next r

        With .UsedRange.Columns("C").Cells
            .TextToColumns Destination:=Range("C1"), _
            DataType:=xlDelimited, _
            OtherChar:="("
        End With

    End With
End Sub

Upvotes: 5

Related Questions