Extract max decimal number from alphanumeric text

[mc51]

Hi, I have an excel file with the following data column

10mm
14.2x198.3x23mm
~3-5.5mm
10 x 15.5 x 20mm

I want to extract the max number of each cell and write to the cell next to it, so the result would be

<table class="cms_table"><tbody><tr class="cms_table_tr" valign="top"><td class="cms_table_td">10mm</td> <td class="cms_table_td"> 10</td><td style="vertical-align: top;">
</td> </tr> <tr class="cms_table_tr" valign="top"><td class="cms_table_td">14.2x198.3x23mm</td> <td class="cms_table_td"> 198.3</td><td style="vertical-align: top;">
</td> </tr> <tr class="cms_table_tr" valign="top"><td class="cms_table_td">~3-5.5mm</td> <td class="cms_table_td"> 5.5</td><td style="vertical-align: top;">
</td> </tr> <tr class="cms_table_tr" valign="top"><td class="cms_table_td">10 x 15.5 x 20mm</td> <td class="cms_table_td"> 20</td><td style="vertical-align: top;">
</td> </tr> </tbody></table>


Can anyone help me? Thanks a lot.

 

[bertie]

Hi and welcome to the forum.

Below is a VBA solution to your problem.

The initial problem is that your data has various deliminators, i.e., "x", "-", "~", " ", etc.

I have created a function to standardize the delimator as a hash mark, "#".

First we set up an array containing the delimators we want to convert. You can add to the list by editing this line of the function:

   [COLOR=green]'add more if necessary[/COLOR],[COLOR=SeaGreen] remember to seperate with a comma[/COLOR]
   arrSpecialChars = Array("x", "~", "-")

We then loop through this array replacing these characters with the hash mark and remove any spaces.

   [COLOR=green]'replace the special characters with a hash mark[/COLOR]
   [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](arrSpecialChars) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](arrSpecialChars)
      txt = Replace(txt, arrSpecialChars(i), "#", vbTextCompare)
   [COLOR=darkblue]Next[/COLOR] i
   
   [COLOR=green]'remove spaces[/COLOR]
   txt = Replace(txt, " ", "", vbTextCompare)

i.e., within the code code your data will look like:
10mm
14.2#198.3#23mm
#3#5.5mm
10#15.5#20mm

This is something we can use.

The ExtractMax procedure.
I have assumed your data is on Sheet1 starting in cell A1.

We loop through column A until we find an empty cell.
We call the function to standardize deliminators, where rng is a cell in column A:

txt = ReplaceSpecialCharacters(rng.Value)

We then use the Split() function to seperate the txt string into an array, using the hash mark as a deliminator:

      [COLOR=green]'split the txt string into an array[/COLOR]
      arrMax = Split(txt, "#")

====================
Edit: For example, the array will store this value 14.2x198.3x23mm as:
arrMax(0) =14.2
arrMax(1)=198.3
arrMax(2)=3.23

We set he max value as the first and loop through the array to see if we can find a larger value.
========================

And we loop through the array to find the maximum value.

      [COLOR=green]'find the max value[/COLOR]
      max = Val(arrMax(0))
      [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](arrMax) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](arrMax)
         [COLOR=darkblue]If[/COLOR] Val(arrMax(i)) > max [COLOR=darkblue]Then[/COLOR]
            max = Val(arrMax(i))
         [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
      [COLOR=darkblue]Next[/COLOR] i

Which is output to column B

      [COLOR=green]'output[/COLOR]
      rng.Offset(, 1).Value = max

The full code is shown below.
To use, cretae a copy of your workbook.
Open the copy and press Alt+F11 to open the vBA editor.
Double click the ThisWorkbook module in the Project Window on the left hand side.
Copy and paste the code below.
Edit where highlighted if necessary.
Press F5 to run.

[COLOR=darkblue]Sub[/COLOR] ExtractMax()
   [COLOR=darkblue]Dim[/COLOR] rng [COLOR=darkblue]As[/COLOR] Range
   [COLOR=darkblue]Dim[/COLOR] txt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] max [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] arrMax [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]           [COLOR=green]'loop variant[/COLOR]
   
   [COLOR=darkblue]Set[/COLOR] rng = Sheets("[COLOR=Red]Sheet1[/COLOR]").Range("[COLOR=Red]A1[/COLOR]")
   
   [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] rng = ""
      txt = ReplaceSpecialCharacters(rng.Value)
      
      [COLOR=green]'split the txt string into an array[/COLOR]
      arrMax = Split(txt, "#")
      
      [COLOR=green]'find the max value[/COLOR]
      max = Val(arrMax(0))
      [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](arrMax) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](arrMax)
         [COLOR=darkblue]If[/COLOR] Val(arrMax(i)) > max [COLOR=darkblue]Then[/COLOR]
            max = Val(arrMax(i))
         [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
      [COLOR=darkblue]Next[/COLOR] i
      
      [COLOR=green]'output[/COLOR]
      rng.Offset(, 1).Value = max
      
      [COLOR=darkblue]Set[/COLOR] rng = rng.Offset(1, 0)
   [COLOR=darkblue]Loop[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Function[/COLOR] ReplaceSpecialCharacters([COLOR=darkblue]ByRef[/COLOR] txt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]) [COLOR=darkblue]As[/COLOR] String
   [COLOR=darkblue]Dim[/COLOR] arrSpecialChars [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]     [COLOR=green]'loop index[/COLOR]
   
   [COLOR=green]'add more if necessary[/COLOR]
   arrSpecialChars = Array("x", "~", "-")
   
   [COLOR=green]'replace the special characters with a hash mark[/COLOR]
   [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](arrSpecialChars) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](arrSpecialChars)
      txt = Replace(txt, arrSpecialChars(i), "#", vbTextCompare)
   [COLOR=darkblue]Next[/COLOR] i
   
   [COLOR=green]'remove spaces[/COLOR]
   txt = Replace(txt, " ", "", vbTextCompare)
   
   [COLOR=green]'output result[/COLOR]
   ReplaceSpecialCharacters = txt
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]

 

[machopicho]

Witnyour data in column A try this:

Sub test()

For r = 1 To 4
Cells(r, 2) = Replace(Cells(r, 1), "mm", "")
Cells(r, 2) = Replace(Cells(r, 2), "-", "x")
Cells(r, 2) = Replace(Cells(r, 2), "~", "")
div = Split(Cells(r, 2), "x")
For i = LBound(div) To UBound(div)
fine = fine + 1
Cells(r, i + 3) = div(i)
Next
myRange = Range(Cells(r, 3), Cells(r, fine))
Cells(r, 2) = WorksheetFunction.Max(myRange)
Cells(r, 2).NumberFormat = "0.0"
rr = r
Next
Range(Cells(1, 3), Cells(rr, fine)).ClearContents

End Sub

 

[Richard Schollar]

Here's a UDF option:
<b>Excel 2002</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>A</th><th>B</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style=";">10mm</td><td style="text-align: right;;">10</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style=";">14.2x198.3x23mm</td><td style="text-align: right;;">198.3</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style=";">~3-5.5mm</td><td style="text-align: right;;">5.5</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style=";">10 x 15.5 x 20mm</td><td style="text-align: right;;">20</td></tr></tbody></table><p style="width:3.6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">Sheet1</p><br /><br /><table width="85%" cellpadding="2.5px" rules="all" style=";border: 2px solid black;border-collapse:collapse;padding: 0.4em;background-color: #FFFFFF" ><tr><td style="padding:6px" ><b>Worksheet Formulas</b><table cellpadding="2.5px" width="100%" rules="all" style="border: 1px solid;text-align:center;background-color: #FFFFFF;border-collapse: collapse; border-color: #A6AAB6"><thead><tr style=" background-color: #E0E0F0;color: #161120"><th width="10px">Cell</th><th style="text-align:left;padding-left:5px;">Formula</th></tr></thead><tbody><tr><th width="10px" style=" background-color: #E0E0F0;color: #161120">B1</th><td style="text-align:left">=getmaxdec(<font color="Blue">A1</font>)</td></tr></tbody></table></td></tr></table><br />

Function GetMaxDec(s As String) As Double
Dim temp
Dim omtch, omtchs
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\d([\d\.]+)?"
    If .test(s) Then
        Set omtchs = .Execute(s)
        For Each omtch In omtchs
            If Val(omtch) > temp Then temp = Val(omtch)
        Next omtch
        GetMaxDec = temp
    End If
End With
End Function

Returns zero if no numeric value present. Does assume that all decimals have at least a leading zero (rather than just a decimal point) - so 0.756 returns 0.756, but .756 will return 756.

 

[Weaver]

Sorry to jump in on this thread, but would you mind explaining how the pattern works in your code please? I don't think I've come across a regexp function that returns an array before.

Cheers,

W

 

[Richard Schollar]

Hi Weaver

The pattern is just searching for any sequence starting with a digit followed by zero or more digits/periods.

The Execute method of the regexp object is used to generate a collection of matching elements from the string passed to it (each match 'consumes' that portion of the string eg so if you have 20x15x30, the first match will be 20 and this is consumed from the string (rather than 2 being matched and then 0 producing a second match), leaving the next match to be 15 and then the last to be 30). I then iterated thru the collection to identify the max value.

Hope the above made sense - it made sense to me when I was thinking about it, but doesn't look so good now it's written down

 

[Jon von der Heyden]

The Execute method of the regexp object is used to generate a collection of matching elements from the string passed to it (each match 'consumes' that portion of the string eg so if you have 20x15x30, the first match will be 20 and this is consumed from the string (rather than 2 being matched and then 0 producing a second match), leaving the next match to be 15 and then the last to be 30). I then iterated thru the collection to identify the max value.

Hungry, perhaps?

 

[Richard Schollar]

I bet you'll be surprised to hear I missed lunch on both Saturday and Sunday at the weekend (and no, I didn't then devour a horse for supper )

 

[Jon von der Heyden]

How on earth did you survive? Were you ill?

Don't think a horse would have cut it. Bison maybe!

How many cans of pop have you consumed today?

 

[Richard Schollar]

Zero cans of pop! I am going cold turkey on the Pepsi Max again. Haven't had any for over a week now