Extract Text Matching a Certain Sequence within a Cell

[Aderonin]

I work for a company and we have type up orders for customers. The way the customers give the info can vary so I tend to use Excel for bigger lists. Sometimes, it's not nice and puts it all into a single cell. I don't know exactly where in the cell the item number or if the number is by itself is but the item number always is 5-6 digits long and starts and ends with a number. It will only have letters and numbers. Can you guys help with a quick script to get the info I need out of the cell?

Example: "PictureFrame5E645BlackBorder" and "TableTop 33ST59 StainlessSteel $59.00" and it should get just 5E645 and 33ST59 here.

Just looking to speed up the work. Thank you.

 

[Peter_SSs]

Welcome to the MrExcel board!

See if this user-defined function would work for you. Post back if you need instruction on how to implement it.

Function ItemNo(s As String) As String
  With CreateObject("VBScript.RegExp")
    .Pattern = "(^|\D)(\d[0-9A-Za-z]{3,4}\d)(\D|$)"
    If .Test(s) Then ItemNo = .Execute(s)(0).SubMatches(1)
  End With
End Function

Aderonin.xlsm
	A	B
1	Text	Item Number
2	PictureFrame5E645BlackBorder	5E645
3	TableTop 33ST59 StainlessSteel $59.00	33ST59
4
5	Other 65T5 Red
6	Picture236TY67Frame5E645BlackBorder	5E645
Sheet1

Cell Formulas
Range	Formula
B2:B6	B2	=ItemNo(A2)

 

[Aderonin]

I was able to add it to a sheet to copy/paste into and it seems to have worked out well. I really appreciate it. It seems pretty simply if I knew VB at all. What would happen if there were multiple instances that fit the criteria? It's very, very unlikely but sometimes, manufacture part numbers could would be that way. Can this output all of them so I can then when I paste it back into the original, I can just choose the correct one? Maybe just in a format like Result1 Result2.

 

[Peter_SSs]

Can this output all of them

Try this version

Function ItemNo(s As String) As Variant
  Dim M As Object
  
  With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(^|\D)(\d[0-9A-Za-z]{3,4}\d)(\D|$)"
    ItemNo = ""
    If .Test(s) Then
      For Each M In .Execute(s)
        ItemNo = ItemNo & " " & M.SubMatches(1)
      Next M
      ItemNo = Split(Mid(ItemNo, 2))
    End If
  End With
End Function

Aderonin.xlsm
	A	B	C	D
1	Text	Item Number
2	PictureFrame5E645BlackBorder	5E645
3	TableTop 33ST59 StainlessSteel $59.00	33ST59
4
5	Other 65T5 Red
6	Picture236TY67Frame5E645BlackBorder	5E645
7	Something12H25 and 895HG6 or 786543	12H25	895HG6	786543
Sheet1

Cell Formulas
Range	Formula
B2:B6,B7:D7	B2	=ItemNo(A2)

 

[Aderonin]

Fantastic. It looks like it threw the extra one of an example into the next column. That should work just fine. Thanks so much.

 

[Peter_SSs]

It looks like it threw the extra one of an example into the next column.

If you would prefer them all in one column it is a minor change:

Function ItemNo(s As String) As Variant
  Dim M As Object
  
  With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(^|\D)(\d[0-9A-Za-z]{3,4}\d)(\D|$)"
    ItemNo = ""
    If .Test(s) Then
      For Each M In .Execute(s)
        ItemNo = ItemNo & ", " & M.SubMatches(1)
      Next M
      ItemNo = Mid(ItemNo, 3)
    End If
  End With
End Function

Aderonin.xlsm
	A	B
1	Text	Item Number
2	PictureFrame5E645BlackBorder	5E645
3	TableTop 33ST59 StainlessSteel $59.00	33ST59
4
5	Other 65T5 Red
6	Picture236TY67Frame5E645BlackBorder	5E645
7	Something12H25 and 895HG6 or 786543	12H25, 895HG6, 786543
Sheet1

Cell Formulas
Range	Formula
B2:B7	B2	=ItemNo(A2)

 

[Aderonin]

It doesn't matter that much but I do like this even better.

 

[Peter_SSs]

Cheers. Thanks for the follow-up.