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

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
 
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
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]
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

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
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
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?
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
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
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
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?
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
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]
Hi, Rick.

In the post #31 it was mentioned that data can be without so strict identifications like "ID:", "OD:", "W:"
... 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. ...
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
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.
@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
@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.
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

Forum statistics

Threads
1,223,956
Messages
6,175,614
Members
452,661
Latest member
Nonhle

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