Extract certain numbers from text placing them in columns

**playtowinpb@msn.com** · 11-16-2012, 11:00 AM

Hello,

I have part descriptions listed in column J. I need to pull the part descriptions out and place them in the correct column (ODL, ODW or IDL) as shown in the sample spreadsheet. My original spreadsheet has 6000+ rows.

ODL = Outside Dimension Length
ODW = Outside Dimension Width
IDW = Inside Dimension Width

Two senarios:
1. Example: Description states 2.00" OD X 1.00" ID will be broke down like so: 2.00 (minus the inch txt) will be listed in column (K) and 1.00 will be listed in column (M).

2. Example: Descpription states 2.00" x 1.00" will be broke down like so: 2.00 (minus the inch txt) will be listed in column (K) and the 1.00 will be listed in column (L).

Factors to consider:
A. In the description it won't always have a (") txt after the number.
B. Any description with one number should be placed in column (K). Example: Part is 8" square.

Any help would be most appreciated!

**TMS** · 11-16-2012, 09:32 PM

I haven't looked at this closely, but to get you started, maybe you could use Text to Columns, delimited by the "X" to split the two dimensions, or one as the case may be. And then again using both space and double quotes to split the number from the descriptor. You should then be able to work up some formulas to check the descriptor columns and copy the dimensions.

Not pretty but it would probably work.

Regards, TMS

**jindon** · 11-17-2012, 01:12 AM

Try the attached

Option Explicit

Sub test()
    Dim r As Range, ODL, ODW, IDW
    With CreateObject("VBScript.RegExp")
        For Each r In Range("j2", Range("j" & Rows.Count).End(xlUp))
            .Pattern = ".* ([\d\.]+).* X ([\d\.]+).* ?(ID).*"
            If .test(r.Value) Then
                ODL = .Replace(r.Value, "$1")
                IDW = .Replace(r.Value, "$2")
            Else
                .Pattern = ".* ([\d\.]+).* ?SQ(UARE)?.*"
                If .test(r.Value) Then
                    ODL = .Replace(r.Value, "$1")
                    ODW = ODL
                Else
                    .Pattern = ".* ([\d\.]+).* X ([\d\.]+).*"
                    If .test(r.Value) Then
                        ODL = .Replace(r.Value, "$1")
                        ODW = .Replace(r.Value, "$2")
                    End If
                End If
            End If
            r(, 2).Resize(, 3) = Array(ODL, ODW, IDW)
            ODL = "": ODW = "": IDW = ""
        Next
    End With
End Sub