Hello karinos57,
This macro will parse the data and places the results in columns "I" and "J". The offsets are measured from column "B". You can change these to copy the data into the columns you choose. I added a button to run the macro. There are 3 lines highlighted in yellow where the your entries and the parsed data differ.
'Written: April 30, 2010
'Author: Leith Ross
Sub PharmaParserA()
Dim Desc As String
Dim R As Long
Dim RegExp As Object
Dim Rng As Range
Dim RngEnd As Range
Set Rng = Range("B3")
Set RngEnd = Cells(Rows.Count, Rng.Column).End(xlUp)
Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Range(Rng, RngEnd))
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
For R = 1 To Rng.Rows.Count
Desc = Rng.Item(R)
RegExp.Pattern = ".*\s([0-9\.]+)X([0-9\.]+)\s.*$"
'End with numbers separated by an "X"
If RegExp.Test(Desc) = True Then
Rng.Item(R).Offset(0, 8).Value = RegExp.Replace(Desc, "$1")
Rng.Item(R).Offset(0, 7).Value = RegExp.Replace(Desc, "$2")
Else
'Ends with a number and zero or more trailing spaces
RegExp.Pattern = ".*\s([0-9\.]+)\s*$"
If RegExp.Test(Desc) = True Then
Rng.Item(R).Offset(0, 8).Value = RegExp.Replace(Desc, "$1")
Rng.Item(R).Offset(0, 7).Value = 1
Else
'Ends with zero or more spaces, and 1 or 2 words preceeded by a number
RegExp.Pattern = ".*\s([0-9\.]+)\s(\w+\s){1,2}\s*$"
If RegExp.Test(Desc) = True Then
Rng.Item(R).Offset(0, 8).Value = 1
Rng.Item(R).Offset(0, 7).Value = RegExp.Replace(Desc, "$1")
Else
'No numbers found
Rng.Item(R).Offset(0, 8).Value = 1
Rng.Item(R).Offset(0, 7).Value = 1
End If
End If
End If
Next R
Set RegExp = Nothing
End Sub
Bookmarks