PDA

View Full Version : Test for Parenthesis at end of string



Djblois
04-29-2009, 01:06 PM
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
04-29-2009, 01:11 PM
Hi Daniel,
Do you need to write the formula, or just get the result?

Djblois
04-29-2009, 01:12 PM
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
04-29-2009, 01:27 PM
As a UDF; Enter =Part(A1)


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

Djblois
04-30-2009, 08:44 AM
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
04-30-2009, 11:41 AM
Hi Daniel,
Assuming your data is in Column A


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

Djblois
04-30-2009, 12:10 PM
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
04-30-2009, 12:11 PM
Can you post some sample data with the differing code positions?

Kenneth Hobs
04-30-2009, 12:55 PM
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