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

[techie2]

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]

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]

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:

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

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

 

[ZVI]

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]

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]

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

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]

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]

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

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]

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]

Well, then try this version, it puts dimensions into the 3 columns for Millimeters and 3 columns for Inches

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]

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

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

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