Help with a formula to extract all 8 character alpha-numeric IDs from an Excel column

T

techie2

New Member
Joined
Jun 4, 2013
Messages
21
I am new to this forum. I have seen some excellent suggestions and solutions being posted.

I have a spread sheet with Special Notes column which has notes text in each cell of the column. Each cell text contains one or more 8 character numeric and alpha numeric IDs. I need to extract all these IDs and dump them in a separate column on the spread sheet . I am giving examples of text from two cells in the column:

K1= Model Z behind model 8 (ABC Company) Please generate AMC 47052130 (replacing dialup AMC 47059003)
K2= Model J behind model 9 (XYZ Company) Please Generate AMC ID 4554G023 (replacing 4554A032)

Is there a formula I can use to extract those 8 character AMC IDs with or without AMC in front of them.

I am very excited to be on this forum.

Thanks in advance

Techie
 
Sort by date Sort by votes
Rick Rothstein said:
ZVI said:
Well, then try this version, it puts dimensions into the 3 columns for Millimeters and 3 columns for Inches
Rich (BB code): 
Sub ExtractDimensions4()
  ' ZVI:2016-02-18 http://www.mrexcel.com/forum/excel-questions/706471-help-formula-extract-all-8-character-alpha-numeric-ids-excel-column.html
  ' Select the source range and run this macro,
  ' dimensions will be on the next 3 columns.
  ' Result: 3 columns in Millimeters + 3 columns in Inches
 
  ' Code of dimensions
  Const ID = "ID", OD = "OD", W = "W"
 
  Dim a, b()
  Dim c As Long, i As Long, j As Long, k As Long, r As Long
  Dim s As String
  Dim Rng As Range
 
  ' Limit selection by the used range to allow selection of the full column
  Set Rng = Intersect(Selection, ActiveSheet.UsedRange)
  If Rng Is Nothing Then Exit Sub
 
  ' Copy values of the selected cells to the array a()
  With Rng
    a = .Value
    If Not IsArray(a) Then
      ReDim a(1 To 1, 1 To 1)
      a(1, 1) = .Value
    End If
  End With
 
  ' Prepare the output array b()
  ReDim b(1 To UBound(a), 1 To 3)
 
  ' Main
  With CreateObject("vbscript.regexp")
    .Global = True
    s = "((" & ID & ")|(" & OD & ")|(" & W & "))"       ' Code
    s = s & "([:;.,\s]?)+"                              ' Symbols
    s = s & "((\d+([\-\s]\d+)?\/\d+\"")|(\d+(\.\d+)?))" ' Inches or Numbers
    .Pattern = s
    i = UBound(b, 2)
    For r = 1 To UBound(a, 1)
      s = a(r, 1)
      If Len(s) Then
        With .Execute(s)
          If .Count > i Then j = i Else j = .Count
          For k = 1 To j
            Select Case .Item(k - 1).SubMatches(0)
              Case ID: c = 1
              Case OD: c = 2
              Case W:  c = 3
            End Select
            b(r, c) = .Item(k - 1).SubMatches(5)
            s = .Item(k - 1).SubMatches(5)
            b(r, c) = s
            If Right$(s, 1) = Chr$(34) Then
              ' Convert Inches to Millimeters
              s = Left(s, Len(s) - 1)
              s = Replace(s, "-", "+")
              s = Replace(s, " ", "+")
              s = "=(" & s & ")*25.4"
              b(r, c) = Evaluate(s)
            End If
            If k = UBound(b, 2) Then Exit For
          Next
        End With
      End If
    Next
  End With
 
  ' Put result in Millimeters into 3 next columns
  With Rng.Offset(, 1).Resize(, UBound(b, 2))
    .NumberFormat = ""  ' General format
    .Value = b()
  End With
 
  ' Put result in Inches into 3 additional columns
  With Rng.Offset(, 1 + UBound(b, 2)).Resize(, UBound(b, 2))
    .Formula = "=IF(LEN(RC[-3]),CONVERT(RC[-3],""mm"",""in""),"""")"
    .Value = .Value
    .NumberFormat = "#-?/?''"
  End With
 
End Sub
Click to expand...
If I am not mistaken, I believe the following macro will produce the same output as your macro...
Code: 
[table="width: 500"]
[tr]
	[td]Sub Extract_ID_OD_W()
  Dim X As Long, ID As String, OD As String, W As String, Temp As Double, Cell As Range, Parts() As String
  On Error Resume Next
  For Each Cell In Selection
    ReDim Parts(1 To 1, 1 To 3)
    For X = 1 To 3
      Temp = Evaluate(Replace(Split(Split(Cell.Value, Choose(X, "ID:", "OD:", "W:"), , vbTextCompare)(1), """")(0), "-", " "))
      Parts(1, X) = Application.Text(Temp, "#-?/?\""") & " [" & Format(Temp * 25.4, "0.00") & "mm]"
    Next
    Cell.Offset(, 1).Resize(, 3) = Parts
    Cell.Offset(, 1).Resize(, 3).Replace 0, "", xlWhole
    Cell.Resize(, 3).NumberFormat = "General"
    Cell.Offset(, 4).Resize(, 3).NumberFormat = "#-?/?\"""
  Next
  On Error GoTo 0
End Sub[/td]
[/tr]
[/table]
Click to expand...
I was mistaken... there were some differences. However, I do believe the following code now matches the output from your macro...
Code: 
[table="width: 500"]
[tr]
	[td]Sub Extract_ID_OD_W()
  Dim X As Long, Temp As Double, ID As String, OD As String, W As String, Cell As Range, Parts() As String
  On Error Resume Next
  For Each Cell In Selection
    ReDim Parts(1 To 1, 1 To 3)
    For X = 1 To 3
      Temp = Evaluate(Replace(Split(Split(Cell.Value, Choose(X, "ID:", "OD:", "W:"), , vbTextCompare)(1), """")(0), "-", " "))
      If Err.Number = 0 Then Parts(1, X) = Replace(Application.Text(Temp, "#-?/?\"""), " ", "") & " [" & Format(Temp * 25.4, "0.00") & "mm]"
      Err.Clear
    Next
    Cell.Offset(, 1).Resize(, 3) = Parts
    Cell.Offset(, 1).Resize(, 3).Replace 0, "", xlWhole
  Next
  On Error GoTo 0
End Sub[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Hello Ziv,

Macro works well except for when finding a whole fraction. Results as below

BS 255 PACK5 VITON O-Ring; BS255V-PACK5; Imperial BS, Viton, Nominal ID:5-5/8" OD:5-7/8" SECT:1/8", Pack 5 142.88 5-5/8'' 149.23 5-7/8''
BS 256 O-Ring; BS256; Imperial BS, Nitrile, Nominal ID:5-3/4" OD:6" SECT:1/8" 146.05 5-3/4'' 6.00 1/4''

BS255.....Perfect
BS256 still returning the imperial dimension?

Many Thanks
 
Upvote 0
AndrewP70 said:
Hello Ziv,

Macro works well except for when finding a whole fraction. Results as below

BS 255 PACK5 VITON O-Ring; BS255V-PACK5; Imperial BS, Viton, Nominal ID:5-5/8" OD:5-7/8" SECT:1/8", Pack 5 142.88 5-5/8'' 149.23 5-7/8''
BS 256 O-Ring; BS256; Imperial BS, Nitrile, Nominal ID:5-3/4" OD:6" SECT:1/8" 146.05 5-3/4'' 6.00 1/4''

BS255.....Perfect
BS256 still returning the imperial dimension?
Click to expand...
Did you try the code I posted in Message #51 yet (it looks like it handles that situation correctly)?
 
Upvote 0
Hi Rick,

I did try the code you suggested, however I require the dimensions in separate columns for the ability to search on either metric or imperial sizes. Your beautiful code returns both dimensions into the same cell. Is it possible to separate?
As usual many many thanks
Andrew
 
Upvote 0
AndrewP70 said:
Hello Ziv,

Macro works well except for when finding a whole fraction. Results as below

BS 255 PACK5 VITON O-Ring; BS255V-PACK5; Imperial BS, Viton, Nominal ID:5-5/8" OD:5-7/8" SECT:1/8", Pack 5 142.88 5-5/8'' 149.23 5-7/8''
BS 256 O-Ring; BS256; Imperial BS, Nitrile, Nominal ID:5-3/4" OD:6" SECT:1/8" 146.05 5-3/4'' 6.00 1/4''

BS255.....Perfect
BS256 still returning the imperial dimension?

Many Thanks
Click to expand...
Yeah, I see the problem. Try this code:
Rich (BB code): 
Sub ExtractDimensions5()
  ' ZVI:2016-02-18 http://www.mrexcel.com/forum/excel-questions/706471-help-formula-extract-all-8-character-alpha-numeric-ids-excel-column.html
  ' Select the source range and run this macro,
  ' dimensions will be on the next 3 columns.
  ' Result: 3 columns in Millimeters + 3 columns in Inches
 
  ' Code of dimensions
  Const ID = "ID", OD = "OD", W = "W", W1 = "SECT"
 
  Dim a, b()
  Dim c As Long, i As Long, j As Long, k As Long, r As Long
  Dim s As String
  Dim Rng As Range
 
  ' Limit selection by the used range to allow selection of the full column
  Set Rng = Intersect(Selection, ActiveSheet.UsedRange)
  If Rng Is Nothing Then Exit Sub
 
  ' Copy values of the selected cells to the array a()
  With Rng
    a = .Value
    If Not IsArray(a) Then
      ReDim a(1 To 1, 1 To 1)
      a(1, 1) = .Value
    End If
  End With
 
  ' Prepare the output array b()
  ReDim b(1 To UBound(a), 1 To 3)
 
  ' Main
  With CreateObject("vbscript.regexp")
    .Global = True
    s = "((" & ID & ")|(" & OD & ")|(" & W & "))"           ' Code
    s = s & "([:;.,\s]?)+"                                  ' Symbols
    s = s & "((\d+([\-\s]\d+)?(\/\d+)?\"")|(\d+(\.\d+)?))"  ' Inches or Numbers
    .Pattern = s
    i = UBound(b, 2)
    For r = 1 To UBound(a, 1)
      If Len(a(r, 1)) Then
        s = Replace(a(r, 1), W1, W)
        With .Execute(s)
          If .Count > i Then j = i Else j = .Count
          For k = 1 To j
            Select Case .Item(k - 1).SubMatches(0)
              Case ID: c = 1
              Case OD: c = 2
              Case W:  c = 3
            End Select
            s = .Item(k - 1).SubMatches(5)
            b(r, c) = s
            If Right$(s, 1) = Chr$(34) Then
              ' Convert Inches to Millimeters
              s = Left(s, Len(s) - 1)
              s = Replace(s, "-", "+")
              s = Replace(s, " ", "+")
              s = "=(" & s & ")*25.4"
              b(r, c) = Evaluate(s)
            End If
            If k = UBound(b, 2) Then Exit For
          Next
        End With
      End If
    Next
  End With
 
  ' Put result in Millimeters into 3 next columns
  With Rng.Offset(, 1).Resize(, UBound(b, 2))
    .NumberFormat = ""  ' General format
    .Value = b()
  End With
 
  ' Put result in Inches into 3 additional columns
  With Rng.Offset(, 1 + UBound(b, 2)).Resize(, UBound(b, 2))
    .Formula = "=IF(LEN(RC[-3]),CONVERT(RC[-3],""mm"",""in""),"""")"
    .Value = .Value
    .NumberFormat = "#-?/?''"
  End With
 
End Sub
 
Upvote 0
AndrewP70 said:
Hi Rick,

I did try the code you suggested, however I require the dimensions in separate columns for the ability to search on either metric or imperial sizes. Your beautiful code returns both dimensions into the same cell. Is it possible to separate?
Click to expand...
Sure, but I need a clarification. In your original posts, the only dimensions were ID, OD and W but in your latest example there is no W but there is a SECT... is SECT supposed to be returned? If so, where... in the column reserved for W or in the next column to the right?
 
Last edited:
Upvote 0
Rick Rothstein said:
I was mistaken... there were some differences. However, I do believe the following code now matches the output from your macro...
Code: 
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub Extract_ID_OD_W()
  Dim X As Long, Temp As Double, ID As String, OD As String, W As String, Cell As Range, Parts() As String
  On Error Resume Next
  For Each Cell In Selection
    ReDim Parts(1 To 1, 1 To 3)
    For X = 1 To 3
      Temp = Evaluate(Replace(Split(Split(Cell.Value, Choose(X, "ID:", "OD:", "W:"), , vbTextCompare)(1), """")(0), "-", " "))
      If Err.Number = 0 Then Parts(1, X) = Replace(Application.Text(Temp, "#-?/?\"""), " ", "") & " [" & Format(Temp * 25.4, "0.00") & "mm]"
      Err.Clear
    Next
    Cell.Offset(, 1).Resize(, 3) = Parts
    Cell.Offset(, 1).Resize(, 3).Replace 0, "", xlWhole
  Next
  On Error GoTo 0
End Sub[/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...
Hi, Rick.

In the post #31 it was mentioned that data can be without so strict identifications like "ID:", "OD:", "W:"
AndrewP70 said:
... I have formatted the basis for an Ecat and would now like to extract the dimensions into separate columns.
Eg (A1)6203-2RS: BRG; Deep groove ball bearing; ID: 17mm, OD40mm, W, 12mm, (2) rubber seals, std clearance.
How can I return the vales after ID (the dimension)? The same will need to apply to OD and W into separate columns. The long text fields I have prepared as above, vary in length and the ID, OD, W will not be the same length. Lastly there could be : or ; after the ID, OD or W. ...
Click to expand...
See also my comments in the post #38.
That was the good reason to use regular expressions for all such cases.

Vlad
 
Last edited:
Upvote 0
ZVI said:
Hi, Rick.

In the post #31 it was mentioned that data can be without so strict identifications like "ID:", "OD:", "W:"

See also my comments in the post #38.
That was the good reason to use regular expressions for all such cases.
Click to expand...
@Vlad and AndrewP70,

Hmm, a lot of messages in this thread and I did not go back far enough. I am a little confused, though, are we simply pulling numbers out from the middle of the text if they follow text? If so, and the text differs from cell to cell, do we just output the numbers one after another or are we supposed to try and line like lead-in textual numbers one under the other? These are probably question more for the OP as opposed to you, but maybe you can give some insight as well. Oh, and I am still expecting to be able to do this efficiently enough without using RegExp, but first I need to understand the required data and it output better than I do now.


@AndrewP70,

Any chance you can post a set of examples that show some of the variations that are possible and also show how you want them to appear after the macro?
 
Last edited:
Upvote 0
Rick Rothstein said:
@Vlad and AndrewP70,

Hmm, a lot of messages in this thread and I did not go back far enough. I am a little confused, though, are we simply pulling numbers out from the middle of the text if they follow text? If so, and the text differs from cell to cell, do we just output the numbers one after another or are we supposed to try and line like lead-in textual numbers one under the other? These are probably question more for the OP as opposed to you, but maybe you can give some insight as well. Oh, and I am still expecting to be able to do this efficiently enough without using RegExp, but first I need to understand the required data and it output better than I do now.
Click to expand...
Alright, I have read through the thread again, but more slowly this time, and it appears we are looking for numbers that follow OD, ID and W with or without colons, commas, and such, so long as these identifiers stand alone. If that is correct, then I think your code (Message #55) needs revision as it is pulling the 1/8" after the SECT: identifier in the example the OP posted in Message #52 (I am assuming that is incorrect based on my understanding of what the OP wants). Let me see if I can modify the code I posted earlier to handle this.
 
Last edited:
Upvote 0
Rick,

My code was built for extracting numbers from selected data in form of:
1. Integers (treating as millimeters)
2. Decimals (treating as millimeters)
3. Inches expressions (integer or fractional)

The identification code before each number: ID = "ID", OD = "OD", W = "W", W1 = "SECT" (modification of W)
Between code and number there can (or can't) be some symbols: [:;, ]

The result is in the 6 next columns to the right: 3 columns are for Millimeters and 3 columns - for Inches.
See more details in my post #43.
Some testing data and the result
Book1
ABCDEFG
1SpecificationID mmOD mmW mmID "OD "W "
26203-2RS: BRG; Deep groove ball bearing; ID: 17mm, OD40mm, W, 12mm, (2) rubber seals, std clearance1740122/3''1-4/7''1/2''
3 ; WOOD ; ... ; ID: 17mm, OD40mm, W, 12mm, (2)1740122/3''1-4/7''1/2''
4EG - Oil Seal; 22527537TC; Imperial, NBR, Double lip, rubber encased, ID:2-1/4" OD:2-3/4" W:3/8"57.1569.859.532-1/4''2-3/4''3/8''
5BS 255 PACK5 VITON O-Ring; BS255V-PACK5; Imperial BS, Viton, Nominal ID:5-5/8" OD:5-7/8" SECT:1/8", Pack 5 142.88 5-5/8'' 149.23 5-7/8''142.88149.233.185-5/8''5-7/8''1/8''
6BS 256 O-Ring; BS256; Imperial BS, Nitrile, Nominal ID:5-3/4" OD:6" SECT:1/8" 146.05 5-3/4'' 6.00 1/4''146.05152.403.185-3/4''6 ''1/8''
Sheet1
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Extract text from an alpha numeric value
Replies
6
Views
991
Tom.Jones
T
G
  • Question Question
extracting alpha numeric characters from one cell into 5 individual cells
2
Replies
10
Views
1K
jtakw
jtakw
M
  • Solved
Help with separating Text String from a Excel Col
Replies
3
Views
592
Peter_SSs
Peter_SSs
B
  • Question Question
Extract two sets of data only (barcode and first address) from a scanned pdf147 barcode into separate columns on a worksheet.
Replies
6
Views
1K
Bassmank
B
S
  • Solved
Need help with simple lookup formula
Replies
5
Views
671
jtakw
jtakw

Forum statistics

Threads
1,223,247
Messages
6,171,004
Members
452,374
Latest member
keccles

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top