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

techie2 · Jun 4, 2013

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

István Hirsch · Feb 18, 2016

Hi ZVI,

The macro in post #36 for 17.5mm gives 17, for 0.5mm gives 0. It would be good to know if there are decimals between the data.

ZVI · Feb 18, 2016

István Hirsch said:
Hi ZVI,
The macro in post #36 for 17.5mm gives 17, for 0.5mm gives 0. It would be good to know if there are decimals between the data.

Good point - thank you! For integers and any decimals this works:

Code:

    .Pattern = "((" & ID & ")|(" & OD & ")|(" & W & "))([:;.,\s]?)+(\d+(\.\d+)?)"

where (\.\d+)? is for decimal part if present.

ZVI · Feb 18, 2016

A short description of the pattern used in the code.

Actually the pattern to be sought is "((ID)|(OD)|(W))([:;.,\s]?)+(\d+(\.\d+)?)"
In words, we are looking for that mask: (Code) (Symbols)(Number)

where:

1. (Code) is (("ID") or ("OD") or ("W")) where round brackets are used for the grouping.

In pattern the symbol "|" is equal to the logical operator Or, thus we have: ((ID)|(OD)|(W))

2. An optional (Symbols) are null or one or some symbols from the set of symbols in square brackets: [:;. ]

Set of the symbols in pattern is also bounded by square brackets, and for the single symbol of that set the pattern can look
like this [:;., ] or like that [:;.,\s] where \s means any type of the space characters including symbol of the space char.

The symbol ? at the end of [:;.,\s]? says that the set of that symbols is optional and its symbol can or can't be present.

The symbol + at the end of ([:;.,\s]?)+ means the possible series of any symbols from that optional set.

3. (Number) actually is a number with or without decimal part.

In the pattern symbol \d requires the single digit,
for the possible sequence of any digits the symbol + is used, so we have \d+ which is for one or more digits.

The pattern of the optional decimal number's part is (\.\d+)?
where:
\. is the dot symbol;
\d+ means one or more digits;
() are used for the grouping;
? means that the previous group (decimal part) is optional - it can or can't be present.

If pattern is matched then result is an zero-based array (of IMatch2 objects) according to the groups in the round brackets of the pattern.

AndrewP70 · Feb 18, 2016

Dear ZVI, the formula works perfectly except for (my mistake here) for ID; OD; W that are listed as fractions.

EG - Oil Seal; 22527537TC; Imperial, NBR, Double lip, rubber encased, ID:2-1/4" OD:2-3/4" W:3/8" - This is returned as 37988.

Can this formula be modified?

Many Thanks,

ZVI · Feb 18, 2016

No formula – it'll be too complicated for all possible cases, at least for me.
Try the below updated version of the macro for extracting Inches and Numbers

Rich (BB code):

Sub ExtractDimensions2()
  ' 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
 
  ' 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+(\-\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)
            'If Not IsNumeric(b(r, c)) Then b(r, c) = "'" & b(r, c)
            If k = UBound(b, 2) Then Exit For
          Next
        End With
      End If
    Next
  End With
 
  ' Copy result into the 3 next columns
  Rng.Offset(, 1).Resize(, 3).Value = b()
 
End Sub

The step by step instruction:
1. Copy the code
2. In sheet press Alt-F11 to open VBE
3. In VBE choose menu Insert – Module
4. Paste the code
5. Press Alt-Q to close VBE
6. Select range of the source cells
7. Press Alt-F8 and run the macro ExtractDimensions2.
The extracted dimensions in Inches or Numbers will appear in the right 3 columns.

Save workbook as XLSM, for further usage steps 6 & 7 are enough

AndrewP70 · Feb 29, 2016

Dear Ziv,
Many thanks for your help with my never ending Ecat.
As per your magnificent macro I have come across a small problem.
When the value from the long description is returned on fractions, I can't seem to convert this to decimals. No matter what I try. Eg the value 12" is returned and I cannot convert from a fraction to decimal. I have tried removing the ", formatting cells etc etc. I did some research and tried a concatenation with a leading zero and this seemed to work fractions that did not contain a whole number. Eg 9/16". I have thousands of fractions that contain a whole number Eg 2 5/16" and need to be able to display the dimensions as both inch and metric (decimal / 25.4)
I am lost and any help is enormously appreciated.
Many Thanks
Andrew

ZVI · Feb 29, 2016

AndrewP70 said:
I have thousands of fractions that contain a whole number Eg 2 5/16" and need to be able to display the dimensions as both inch and metric (decimal / 25.4)

See if this code suits. It automatically adds Inches-To-Millimeters measure into the cells, like this:
2-1/4" [57.15mm]
2 3/4" [69.85mm]
3/8" [9.53mm]
and so on

Rich (BB code):

Sub ExtractDimensions3()
  ' 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.
  ' Inches are converted to Millimeters as well.
 
  ' 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
              ' Build formula to convert Inches to Millimeters
              s = Left(s, Len(s) - 1)
              s = Replace(s, "-", "+")
              s = Replace(s, " ", "+")
               s = "=(" & s & ")*25.4"
              ' Concatenate the [mm] measure
              b(r, c) = b(r, c) & " [" & Format(Evaluate(s), "#0.00") & "mm]"
            End If
            If k = UBound(b, 2) Then Exit For
          Next
        End With
      End If
    Next
  End With
 
  ' Copy result into the 3 next columns
  Rng.Offset(, 1).Resize(, 3).Value = b()
 
End Sub

AndrewP70 · Feb 29, 2016

Hi Ziv, this is perfect, except is there anyway the metric dimensions and Imperial dimensions could have their own columns?
Once again many thanks.
Regards
Andrew

ZVI · Feb 29, 2016

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

Rick Rothstein · Feb 29, 2016

ZVI said:

See if this code suits. It automatically adds Inches-To-Millimeters measure into the cells, like this:
2-1/4" [57.15mm]
2 3/4" [69.85mm]
3/8" [9.53mm]
and so on

Rich (BB code):

Sub ExtractDimensions3()
  ' 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.
  ' Inches are converted to Millimeters as well.
 
  ' 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
              ' Build formula to convert Inches to Millimeters
              s = Left(s, Len(s) - 1)
              s = Replace(s, "-", "+")
              s = Replace(s, " ", "+")
               s = "=(" & s & ")*25.4"
              ' Concatenate the [mm] measure
              b(r, c) = b(r, c) & " [" & Format(Evaluate(s), "#0.00") & "mm]"
            End If
            If k = UBound(b, 2) Then Exit For
          Next
        End With
      End If
    Next
  End With
 
  ' Copy result into the 3 next columns
  Rng.Offset(, 1).Resize(, 3).Value = b()
 
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]

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

techie2

New Member

István Hirsch

Well-known Member

Excel Facts

ZVI

MrExcel MVP

ZVI

MrExcel MVP

AndrewP70

New Member

ZVI

MrExcel MVP

AndrewP70

New Member

ZVI

MrExcel MVP

AndrewP70

New Member

ZVI

MrExcel MVP

Rick Rothstein

MrExcel MVP

Similar threads

Forum statistics

Share this page

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

New Member

Well-known Member

Excel Facts

MrExcel MVP

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock