Extract 5 digit numbers from cell and separate them by |

[dougbohr]

Hello, this is my first post. Any help is greatly appreciated!

I need to reformat construction cost codes that are coming from business contacts in Outlook. I am exporting a .csv file from Outlook that contains hundreds of rows (each row is a company contact). When I export, the cost code column cell also contains a text description. I ONLY need the (5) digit cost code number, and if there are multiple cost codes, they need to be separated by a vertical bar |

Example:

"00815 Land Surveyors;MBE / WBE / DBE; Subcontractor" = "00815"
"13000 Special Construction; Subcontractor" = "13000"
"02525 Curbing;02900 Landscaping;03300 Concrete;16100 Eleectrical;MBE / WBE / DBE;Subcontractor" = "02525 | 02900 | 03300 | 16100"
"08100 Hollow Metal;08200 Wood Doors;08700 Hardware;Supplier"= "08100 | 08200 | 08700"

Is there any way to extract ONLY the (5) digit cost code, and separate them by "space, vertical bar, space" (if the cell contains more than 1 cost code)?

Thanks!
Doug Bohr

 

[KRIXX]

For those who might be interested, here is a non-RegExp UDF (user defined function) that can be used...

Function GetDigitNums(ByVal S As String) As String
  Dim X As Long, Arr As Variant
  For X = 1 To Len(S)
    If Mid(S, X, 1) Like "[!0-9]" Then Mid(S, X) = " "
  Next
  Arr = Split(Application.Trim(S))
  For X = 0 To UBound(Arr)
    If Len(Arr(X)) <> 5 Then Arr(X) = ""
  Next
  GetDigitNums = Replace(Application.Trim(Join(Arr)), " ", " | ")
End Function

This UDF takes only one argument... the text to be processed (which can be a quoted text string or a cell reference that contains the text); so, to call it, you would use something like this...

=GetDigitNums(A1)

@ Rick Rothstein

I was facing problem for the same issue that how to get numbers extract from the string. In my case there is 8 digit numbers. I have used your code and changed number 8 from 5 in ' If Len(Arr(X)) <> ' and it works fine. But what i expect is if you can help me it will be very helpful since i have to deal with thousands of this type data.

What i want is all 8 digit numbers should be returned in different cell instead of "|" separator. for example if my raw data is in cell A1 and it contains three 8 digit numbers than it should be returned in cell A2, A3, A4. I hope you will understand what I want to say.

Thank You.

 

[Peter_SSs]

@KRIXX
Could you give us a small set of dummy sample data that shows us the sort of variety we might find with your data? Also include the expected results.
For example, might any of the 8-digit numbers begin with zero and, if so, do you want any leading zeros preserved in the results?
XL2BB would be best so we can copy/paste the samples for testing.
Hopefully the sample & expected results will also resolve the question below.

if my raw data is in cell A1 and it contains three 8 digit numbers than it should be returned in cell A2, A3, A4.

Just checking that is the correct location for results and not B1, C1, D1?

 

[sandy666]

just for fun for OP

raw	Codes
00815 Land Surveyors;MBE / WBE / DBE; Subcontractor	00815
13000 Special Construction; Subcontractor	13000
02525 Curbing;02900 Landscaping;03300 Concrete;16100 Eleectrical;MBE / WBE / DBE;Subcontractor	02525 | 02900 | 03300 | 16100
08100 Hollow Metal;08200 Wood Doors;08700 Hardware;Supplier	08100 | 08200 | 08700

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    TS = Table.AddColumn(Source, "Nums", each Text.Select([raw],{"0".."9"})),
    Split = Table.SplitColumn(TS, "Nums", Splitter.SplitTextByRepeatedLengths(5), {"Nums.1", "Nums.2", "Nums.3", "Nums.4"}),
    TCC = Table.CombineColumns(Split,{"Nums.1", "Nums.2", "Nums.3", "Nums.4"},Combiner.CombineTextByDelimiter("|", QuoteStyle.None),"Code"),
    TTE = Table.AddColumn(TCC, "Codes", each Text.TrimEnd([Code],"|")),
    TRV = Table.ReplaceValue(TTE,"|"," | ",Replacer.ReplaceText,{"Codes"}),
    RC = Table.RemoveColumns(TRV,{"Code"})
in
    RC

 

[KRIXX]

@ Peter_SSs

Free File Hosting - Online Storage; Upload Mp3, Videos, Music. Backup Files

I think it will be help to understand my query.

 

[Peter_SSs]

Give this a try with a copy of your workbook.

Sub Extract_Nums()
  Dim RX As Object, M As Object
  Dim a As Variant
  Dim i As Long
  Dim s As String
  
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value2
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "(^|\D)(\d{8})(?=\D|$)"
  For i = 1 To UBound(a)
    s = vbNullString
    For Each M In RX.Execute(a(i, 1))
      s = s & ";" & Mid(M, 2)
    Next M
    a(i, 1) = s
  Next i
  With Range("B1").Resize(UBound(a))
    .Value = a
    .TextToColumns DataType:=xlDelimited, Semicolon:=True, Other:=False, FieldInfo:=Array(1, 9)
  End With
End Sub

 

[KRIXX]

Give this a try with a copy of your workbook.

Sub Extract_Nums()
  Dim RX As Object, M As Object
  Dim a As Variant
  Dim i As Long
  Dim s As String
 
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value2
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "(^|\D)(\d{8})(?=\D|$)"
  For i = 1 To UBound(a)
    s = vbNullString
    For Each M In RX.Execute(a(i, 1))
      s = s & ";" & Mid(M, 2)
    Next M
    a(i, 1) = s
  Next i
  With Range("B1").Resize(UBound(a))
    .Value = a
    .TextToColumns DataType:=xlDelimited, Semicolon:=True, Other:=False, FieldInfo:=Array(1, 9)
  End With
End Sub

Thank You Very Much Bro...
It works like Charm. It will really help me a lot and will save my lot of time.
One more request If you can help me this it will be greatly appreciated.
Please take a look in to this thread also

highlight duplicate in single column after specific word

I am attaching excel workbook. after opening it you will see that in column A there are 162 records. In records you will notice that after some item numbers there is "Item" written. I want to use this word "Item" as separator of this records and highlights duplicate values which are begins after...

www.mrexcel.com

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.