Test for Parenthesis at end of string

[Djblois]

I have been using code for the longest time to test for parenthesis in a string and then move the string in between them to another cell. The reason I had to do this is it is a string that consists of both Product Description and Product Code and I need them in two seperate fields. However, now some people in my company have started using Parenthesis in the product descriptions making my code now work correctly. Here is the code I have been using:

With Range("B2:B" & finalrow(wsWorking))
            .FormulaR1C1 = _
            "=MID(RC[-1],FIND(""("",RC[-1])+1,FIND("")"",RC[-1])-FIND(""("",RC[-1])-1)"
            .Value = Range("B2:B" & finalrow(wsWorking)).Value
            .Replace What:="-", Replacement:="" 'Remove - from Column B
        End With

and here is a copy of one of the item descriptions:

'CELEBRITY DANISH BACK RIBS (17-23) (TS) 1/30# (298849)

I can't use right because some product codes are larger than 6 and sometimes it is on the left. However, it is always on the outside of the description - so it is always either the last thing or the first thing. How can I exclude the parenthesis from the middle in the find? or if that can't be down I will settle with being able to say just the parenthesis at the end (on the right side)

[mdmackillop]

Hi Daniel,
Do you need to write the formula, or just get the result?

[Djblois]

I don't need it to be a formula. I just need to get the code from in between into another column. Any way possible.

[mdmackillop]

As a UDF; Enter =Part(A1)

[vba]
Function Part(Data As Range)
If Left(Data, 1) = "(" Then
p = Split(Data, ")")(0)
Part = Right(p, Len(p) - 1)
Else
p = Split(Data, "(")(UBound(Split(Data, "(")))
Part = Left(p, Len(p) - 1)
End If
End Function

[/vba]

[Djblois]

I am having one issue. I need to get this to work on a large range all at once. However it keeps crashing. I need it to work on this range :

Range("B2:B" & finalrow(wsWorking))

I tried it this way:

Range("B2:B" & finalrow(wsWorking)).Value = Part(Range("B2:B" & finalrow(wsWorking)))

and this way:

With Range("B2:B" & finalrow(wsWorking)).FormulaR1C1 = "=PART(RC[-1]"

and they both crashed. Finalrow is a function that I have defined to find the final row in a spreadsheet and wsWorksheet is a variable for a worksheet. Here is the code for finalrow in case you want to look at it:

Function finalrow(ByVal shtToCount As Worksheet) As Long

    Dim rowTest As Long, columnTest As Integer, finalRowLast As Long, lastColumn As Integer, lgRepeat As Byte
    'Determines Final row in Sheet
    lastColumn = shtToCount.Cells(1, Columns.Count).End(xlToLeft).Column
    
    finalrow = shtToCount.Cells(Rows.Count, 1).End(xlUp).Row
    finalRowLast = shtToCount.Cells(Rows.Count, lastColumn).End(xlUp).Row
    If finalRowLast > finalrow Then finalrow = finalRowLast
    
    'loop to find Actual Final row
    For lgRepeat = 1 To 2
        columnTest = shtToCount.Cells(finalrow + 1, 1).End(xlToRight).Column
        rowTest = shtToCount.Cells(Rows.Count, columnTest).End(xlUp).Row
        
        If rowTest > finalrow Then finalrow = rowTest
    Next
    
End Function

[mdmackillop]

Hi Daniel,
Assuming your data is in Column A

[vba]
Option Explicit

'Option 1
Sub InsertVals()
Dim Cel As Range
For Each Cel In Range(Cells(1, 1), LastCel(1))
Cel.Offset(, 1) = Part(Cel)
Next
End Sub

'Option 2
Sub InsertFormulas()
Dim Cel As Range
For Each Cel In Range(Cells(1, 1), LastCel(1))
Cel.Offset(, 1).FormulaR1C1 = "=Part(R[0]C[-1])"
Next
End Sub

Function LastCel(Col) As Range
Set LastCel = Cells(Rows.Count, Col).End(xlUp)
End Function

Function Part(Data As Range)
Dim p
If Left(Data, 1) = "(" Then
p = Split(Data, ")")(0)
Part = Right(p, Len(p) - 1)
Else
p = Split(Data, "(")(UBound(Split(Data, "(")))
Part = Left(p, Len(p) - 1)
End If
End Function

[/vba]

[Djblois]

Yes you were correct my data is in column A and following your instruction I no longer have the error that I was getting. However, I am getting the same result that I was getting using my old formula. It isn't finding the code.

[mdmackillop]

Can you post some sample data with the differing code positions?

[Kenneth Hobs]

[VBA]Sub Test_StripEndPs()
[a1] = "CELEBRITY DANISH BACK RIBS (17-23) (TS) 1/30# (298849)"
[a2] = "(CELEBRITY) DANISH BACK RIBS (17-23) (TS) 1/30# 298849"
[a3] = "CELEBRITY DANISH BACK RIBS (17-23) (TS) 1/30# 298849"

StripEndPs Range("A1", Range("A" & Rows.Count).End(xlUp))
End Sub

'=StripEndPs(A1)
Sub StripEndPs(someRange As Range)
Dim c As Range, s As String, np As Integer
For Each c In someRange
s = c.Value
If Left(s, 1) = "(" Then
s = Right(s, Len(s) - 1)
np = InStr(s, ")")
s = Mid(s, 1, np - 1) & Mid(s, np + 1)
c.Value = s
End If
If Right(s, 1) = ")" Then
s = Left(s, Len(s) - 1)
np = InStrRev(s, "(")
s = Mid(s, 1, np - 1) & Mid(s, np + 1)
c.Value = s
End If
Next c
End Sub[/VBA]